TITLE  'ICATS GET-DATA-FROM-A-UTS-AND-WRITE-IT-TO-A-CMS-FILE ROUTINE' WRI00010
*********************************************************************** WRI00020
*                                                                     * WRI00030
*  MODULE NAME =  WRITE                                               * WRI00040
*                                                                     * WRI00050
*  FUNCTION =  RETRIEVE DATA FROM THE REQUESTING UTS MACHINE AND      * WRI00060
*              WRITE IT TO A CMS FILE.                                * WRI00070
*                                                                     * WRI00080
*  ENTRY POINTS =  WRITE                                              * WRI00090
*                                                                     * WRI00100
*  LINKAGE =  BALR R14,R15 FROM ICATS MAINLINE.                       * WRI00110
*                                                                     * WRI00120
*  REGISTER CONTENTS UPON ENTRY =                                     * WRI00130
*      R2  = POINTS TO THE ICATS COMMON DATA AREA, AS ALWAYS.         * WRI00140
*      R14 = RETURN ADDRESS BACK TO ICATS MAINLINE                    * WRI00150
*      R15 = ENTRY POINT TO THIS MODULE                               * WRI00160
*                                                                     * WRI00170
*  REGISTER USAGE =                                                   * WRI00180
*      R0-R1 = USED TO PASS PARAMETERS TO SUBROUTINES.                * WRI00190
*      R2 =  USED TO ADDRESS THE ICATS COMMON DATA AREA.              * WRI00200
*      R3  = TEMPORARILY USED TO ADDRESS THE FILE STATUS TABLE (FST), * WRI00210
*            THEN DROPPED.  LATER, AFTER THE FILE IS OPENED, IT'S     * WRI00220
*            USED TO ADDRESS THE FILE SYSTEM CONTROL BLOCK (FSCB).    * WRI00230
*      R4 =  USED TO ADDRESS CURRENT UTS CONTROL BLOCK.               * WRI00240
*      R5 =  USED TO ADDRESS CURRENT USER CONTROL BLOCK.              * WRI00250
*      R6 =  USED TO ADDRESS CURRENT DISK CONTROL BLOCK.              * WRI00260
*      R7 =  USED TO COUNT THE NUMBER OF RECORDS I'VE WRITTEN.        * WRI00270
*      R8 =  NUMBER OF BYTES LEFT TO DO IN THE INPUT BUFFER.          * WRI00280
*      R9 =  USED TO ADDRESS THE CURRENT RECORD IN THE INPUT BUFFER.  * WRI00290
*      R11 = MY BASE REGISTER                                         * WRI00300
*      R14 = MY RETURN ADDRESS WHEN I CALL SOMEBODY                   * WRI00310
*      R15 = SUBROUTINE ADDRESS                                       * WRI00320
*                                                                     * WRI00330
*                                                                     * WRI00340
*  MODULE LOGIC:                                                      * WRI00350
*      1)  CALL THE ACCESS ROUTINE TO                                 * WRI00360
*          A)  LOCATE THE CORRECT UTSCB,                              * WRI00370
*          B)  LOCATE THE CORRECT USERCB,                             * WRI00380
*          C)  LOCATE THE CORRECT DISKCB,                             * WRI00390
*          D)  AND TO ACCESS THE CORRECT MINIDISK.                    * WRI00400
*      2)  CHECK THE WRITE PASSWORD THE UTS USER SUPPLIED WITH        * WRI00410
*          THE ONE HE'S SUPPOSE TO SUPPLY FOR THIS MINIDISK.          * WRI00420
*          A)  CL8'ALL' = HE DOESN'T NEED A PASSWORD TO WRITE.        * WRI00430
*          B)  CL8'NONE' = HE CAN'T WRITE NO MATTER WHAT              * WRI00440
*                          PASSWORD HE GAVE US.                       * WRI00450
*          C)  ELSE VERIFY THE PASSWORD HE GAVE US.                   * WRI00460
*      3)  INSURE A VALID SUBFUNCTION WAS SPECIFIED AND SET FLAGS     * WRI00470
*          ACCORDINGLY.  DETERMINE THE FILE NAME TO BE USED           * WRI00480
*          (THIS DETERMINATION DEPENDS ON THE SUBFUNCTION             * WRI00490
*          SPECIFIED).  THE VALID SUBFUNCTIONS INCLUDE;               * WRI00500
*          A)  CREATE (THIS IS THE DEFAULT IF LEFT BLANK).  THIS      * WRI00510
*              WILL ABORT THIS WRITE REQUEST IF A FILE ALREADY        * WRI00520
*              EXISTS WITH THIS FILENAME.                             * WRI00530
*          B)  REPLACE.  WE'LL DO AN ERASE OF THIS FILE FIRST.        * WRI00540
*          C)  INCRVL.  THIS WILL SEARCH THE SPECIFIED MINIDISK TO    * WRI00550
*              DETERMINE THE FILENAME TO BE USED FOR THIS NEW FILE.   * WRI00560
*              IF THE FILENAME HE REQUESTED IS BEING USED BY SOME     * WRI00570
*              OTHER FILE, WE'LL CHANGE THE FILENAME TO THE FIRST     * WRI00580
*              FREE FILENAME WE FIND USING THIS SEARCH ORDER;         * WRI00590
*              XXXXX000 - XXXXX999  WHERE XXXXX = THE FIRST FIVE      * WRI00600
*                                   CHARACTERS OF THE GIVEN FILENAME. * WRI00610
*          D)  APPEND.  IF A FILE WITH THIS FILENAME ALREADY EXISTS   * WRI00620
*              THEN THIS DATA WILL BE APPENDED TO THAT FILE.  ELSE    * WRI00630
*              A BRAND NEW FILE WILL BE CREATED WITH THIS FILENAME    * WRI00640
*              AND THIS DATA.                                         * WRI00650
*          E)  DA (DIRECT ACCESS WRITE).  ALLOWS THE USER TO          * WRI00660
*              SPECIFY THE STARTING RECORD NUMBER OF CMS FILE TO      * WRI00670
*              START WRITING TO.  THE CMS FILE MUST HAVE A FIXED      * WRI00680
*              LENGTH RECORD FORMAT.                                  * WRI00690
*      4)  GO GET THE DATA FROM THE UTS MACHINE.  THIS IS A           * WRI00700
*          SEPARATE SIO THAN THE ONE USED TO GET THE REQUEST          * WRI00710
*          CONTROL BLOCK.                                             * WRI00720
*      5)  OPEN THE FILE AND, IF THIS IS A DA WRITE, THEN DO A        * WRI00730
*          FSPOINT TO START WRITING AT THE SPECIFIED RECORD.          * WRI00740
*      6)  START WRITING UNTIL YOU'VE WRITTEN ALL THE DATA HE'S       * WRI00750
*          PASSED US.                                                 * WRI00760
*          A)  DETERMINE THE LENGTH OF THE NEXT INPUT RECORD.         * WRI00770
*          B)  DETERMINE THE LENGTH OF THE NEXT OUTPUT RECORD.        * WRI00780
*          C)  PAD OR TRUNCATE THE INPUT RECORD AS NEEDED.            * WRI00790
*          D)  WRITE THIS RECORD INTO THE CMS FILE.                   * WRI00800
*      7)  CLOSE THE CMS FILE.                                        * WRI00810
*      8)  GIVE A REPLY TO THE UTS MACHINE TELLING WHAT HAPPENED.     * WRI00820
*          INCLUDE STARTING RECORD # FOR NEXT WRITE,                  * WRI00830
*          CMS FILE CHARACTERISTICS (RECORD FORMAT, LOGICAL           * WRI00840
*          RECORD LENGTH, AND NUMBER OF RECORDS IN THE FILE),         * WRI00850
*          AND THE BIGGEST RECORD I FOUND IN THE INPUT DATA.          * WRI00860
*                                                                     * WRI00870
*  NORMAL EXIT =                                                      * WRI00880
*      R15 = 0                                                        * WRI00890
*                                                                     * WRI00900
*  EXTERNAL REFERENCES = NONE                                         * WRI00910
*                                                                     * WRI00920
*  MACROS =  ICDATA = ICATS COMMON DATA AREA                          * WRI00930
*            ETTE   = ENTER TRACE TABLE ENTRY SUBROUTINE              * WRI00940
*                                                                     * WRI00950
*  CHANGE ACTIVITY                                                    * WRI00960
*    DATE        NAME       REASON FOR CHANGE                         * WRI00970
*  02/25/83  RICK JASPER    INITIAL PROGRAM CREATION                  * WRI00980
*  05/03/83  RICK JASPER    ADDED UTS SOURCE RECORD FORMAT SUPPORT    * WRI00990
*                                                                     * WRI01000
*********************************************************************** WRI01010
         PRINT GEN,NODATA                                               WRI01020
WRITE    CSECT                                                          WRI01030
         USING ICDATA,R2            ADDRESS ICATS COMMON DATA AREA      WRI01040
         USING CBUTS,R4          USE R4 TO ADDRESS UTS CONTROL BLOCK    WRI01050
         USING CBUSER,R5         USE R5 TO ADDRESS USER CONTROL BLOCK   WRI01060
         USING CBDISK,R6         USE R6 TO ADDRESS DISK CONTROL BLOCK   WRI01070
         USING *,R15      USE R15 FOR BASE REG NEXT INSTRUCTION ONLY    WRI01080
         STM   R0,R14,REGSAVE       SAVE CALLER'S REGISTERS             WRI01090
         DROP  R15                                                      WRI01100
         USING WRITE,R11            R11 WILL BE BASE REGISTER           WRI01110
         LR    R11,R15              ESTABLISH BASE REGISTER             WRI01120
*                                                                       WRI01130
*    WRITE COMMANDS CAN ONLY COME FROM A UTS MACHINE                    WRI01140
         TM    FLAGB,UTSCMD      DID THIS COMMAND COME FROM A UTS ??    WRI01150
         BO    CON50             YES IT DID.  GOOD.  CONTINUE ON.       WRI01160
         L     R15,AREJECT        GO TO REJECT-THIS-COMMAND ROUTINE     WRI01170
         BALR  R14,R15                                                  WRI01180
         B     WRITEBYE                                                 WRI01190
*    INITIALIZE EVERYTHING.                                             WRI01200
CON50    DS    0H                                                       WRI01210
         XC    UTSPARMS,UTSPARMS       CLEAR ALL THE PARMS AT ONCE      WRI01220
         MVI   RITFLAGA,X'00'          CLEAR WRITE STATUS FLAG          WRI01230
         MVI   RITFLAGB,X'00'          CLEAR THE OTHER ONE              WRI01240
         CLI   PARM4,C'›'                                               WRI01250
         BNE   NOCENT                                                   WRI01260
         MVI   PARM4,C'#'                                               WRI01270
NOCENT   DS    0H                                                       WRI01280
*    PREPARE FOR ACCESS ROUTINE.                                        WRI01290
         MVC   THISUSER,PARM0    MOVE IN UTS USER ID                    WRI01300
         MVC   THISDISK,PARM6    MOVE IN THE DISK HE WANTED             WRI01310
         L     R15,AACCESS       GET ADDRESS OF ACCESS ROUTINE          WRI01320
         BALR  R14,R15           GO FIND ALL THE CONTROL BLOCKS         WRI01330
*    UPON RETURN, IF THERE WAS AN ERROR, THEN R15 > 0,                  WRI01340
*                 ELSE R15 = 0 AND R4, R5, AND R6 ALL POINT TO THE      WRI01350
*                 CORRECT UTSCB, USERCB, AND DISKCB RESPECTIVELY.       WRI01360
         LTR   R15,R15                                                  WRI01370
         BNZ   ERROR1            GO FIGURE OUT WHAT THE ERROR WAS       WRI01380
*    NOW CHECK THE WRITE PASSWORD THIS GUY GAVE ME FOR THIS DISK        WRI01390
         CLC   CBDSKWPW,=CL8'ALL'    DOES HE REQUIRE A PASSWORD ??      WRI01400
         BE    CON100                NOPE, CONTINUE ON                  WRI01410
         CLC   CBDSKWPW,=CL8'NONE'   IS HE ALLOWED TO WRITE ON THIS     WRI01420
         BE    ERROR2                DISK ??  NOPE, TELL HIM SO         WRI01430
         CLC   CBDSKWPW,PARM7   NOT SPECIAL CASE - COMPARE PASSWORD     WRI01440
         BNE   ERROR3           PASSWORD IS INCORRECT                   WRI01450
CON100   DS    0H                                                       WRI01460
*    OK, THE PASSWORD CHECKS.  NOW MAKE SURE HE'S GIVEN US A VALID      WRI01470
*   SUBFUNCTION.  CHECK FOR CREATE, REPLACE, INCRVL, APPEND, OR DA      WRI01480
*   (THE DEFAULT IF BLANK, IS CREATE).  ANYTHING ELSE WILL BE           WRI01490
*   REJECTED.  ONCE YOU'VE GOT A VALID SUBFUNCTION, DETERMINE THE       WRI01500
*   FILE NAME TO BE USED AND TAKE CARE OF ANY OTHER PARAMETERS          WRI01510
*   PECULIAR TO THIS SUBFUNCTION.                                       WRI01520
         CLC   PARM2,=CL8' '        CHECK FOR DEFAULT OF CREATE         WRI01530
         BE    CON110                                                   WRI01540
         CLC   PARM2,=CL8'CREATE'   CHECK FOR CREATE                    WRI01550
         BNE   CON120               NOPE, CHECK NEXT SUBFUNCTION        WRI01560
CON110   DS    0H                                                       WRI01570
         OI    RITFLAGB,CREATE      THIS IS A CREATE WRITE              WRI01580
*   SEE IF THERE'S ALREADY A FILE WITH THIS FILE ID.  IF SO, THEN       WRI01590
*   REJECT THIS REQUEST.  DO A FSSTATE.  THE FSSTATE WILL ALSO          WRI01600
*   LET US KNOW IF THE FILENAME OR FILETYPE CONTAINS INVALID            WRI01610
*   CHARACTERS.                                                         WRI01620
         LA    R8,PARM4        GET ADDRESS OF FILE ID (FN FT FM)        WRI01630
         FSSTATE (R8)          DOES THIS FILE EXIST ??                  WRI01640
         LTR   R15,R15                                                  WRI01650
         BZ    ERROR4          YES, IT DOES.  REJECT THIS WRITE.        WRI01660
         C     R15,=F'28'      WAS THE FILE NOT FOUND ??  (EXPECTED)    WRI01670
         BE    CON200          YEP, IT WASN'T FOUND.  CONTINUE ON       WRI01680
         C     R15,=F'20'      INVALID CHARACTER IN FILE ID ??          WRI01690
         BE    ERROR5                                                   WRI01700
         B     ERROR6          SOME OTHER FSSTATE ERROR.                WRI01710
*   CONTINUE CHECKING FOR VALID SUBFUNCTIONS.                           WRI01720
CON120   DS    0H                                                       WRI01730
         CLC   PARM2,=CL8'REPLACE'  CHECK FOR REPLACE WRITE             WRI01740
         BNE   CON130                                                   WRI01750
         OI    RITFLAGB,REPLACE      THIS IS A REPLACE WRITE            WRI01760
*   DO AN FSERASE FOR THIS FILE ID.  IGNORE A RC = 28 = FILE-NOT-FOUND  WRI01770
*   RETURN CODE.  DON'T IGNORE A RC = 20 = INVALID FILE ID RETURN CODE. WRI01780
*   FLAG THAT AS AN ERROR.                                              WRI01790
         LA    R8,PARM4           GET ADDRESS OF FILE ID (FN FT FM)     WRI01800
         FSERASE (R8)             ERASE THE FILE IF IT EXISTS           WRI01810
         LTR   R15,R15            DID THINGS GO OK ??                   WRI01820
         BZ    CON125             YEP, THE FILE DID EXIST               WRI01830
         C     R15,=F'28'                                               WRI01840
         BE    CON125             IT'S OK IF THE FILE DID NOT EXIST     WRI01850
         C     R15,=F'20'         CHECK FOR INVALID FILE ID             WRI01860
         BE    ERROR5             TSK TSK                               WRI01870
         B     ERROR7             SOME OTHER ERROR WITH THE FSERASE     WRI01880
CON125   DS    0H                                                       WRI01890
         B     CON200      OTHERWISE, EVERYTHING'S GREAT.  CONTINUE ON  WRI01900
*   CONTINUE CHECKING FOR VALID SUBFUNCTIONS.                           WRI01910
CON130   DS    0H                                                       WRI01920
         CLC   PARM2,=CL8'INCRVL'   CHECK FOR WRITE AND INCREMENT       WRI01930
         BNE   CON140               THE VERSION LEVEL                   WRI01940
         OI    RITFLAGB,INCRVL      THAT'S WHAT THIS IS                 WRI01950
*   THIS IS WHERE I'VE GOT TO WORK.  FIRST SEE IF THIS FILE EXISTS OR   WRI01960
*   NOT.  IF IT DOESN'T, FINE - USE THIS FILE ID.                       WRI01970
*   OTHERWISE, FIND THE FIRST BLANK CHARACTER IN THE FILENAME OR THE    WRI01980
*   FIFTH CHARACTER, WHATEVER COMES FIRST.  CHANGE THE FILENAME         WRI01990
*      FROM HISNAME  ==>  TO HISNA000                                   WRI02000
*   OR FROM NAME     ==>  TO NAME000.  REMEMBER WHERE THE 000'S START.  WRI02010
*   NOW, DOES THAT FILE EXIST ??  IF SO, USE THAT FILE ID.              WRI02020
*   IF NOT, INCREMENT THE 000'S TO 001, THEN 002, ETC. UNTIL YOU FIND   WRI02030
*   A FILE ID THAT ISN'T BEING USED OR YOU GO PAST 999.  IF YOU GO      WRI02040
*   PAST 999, THEN REJECT THIS WRITE REQUEST (THE BLOODY FOOL'S GOT     WRI02050
*   1,001 FILES ON HIS DISK, HE DESERVES THIS 1,002ND TO BE REJECTED).  WRI02060
         LA    R8,PARM4        GET ADDRESS OF FILE ID (FN FT FM)        WRI02070
         FSSTATE (R8)          DOES THIS FILE EXIST ??                  WRI02080
         C     R15,=F'28'      WAS THE FILE NOT FOUND ??  (EXPECTED)    WRI02090
         BE    CON139          GOOD, WE CAN USE HIS ORIGINAL FILE ID.   WRI02100
         C     R15,=F'20'      IS THIS FILE ID INVALID ??               WRI02110
         BE    ERROR5          YEP, BAD CHARACTER IN FILENAME OR TYPE.  WRI02120
         LTR   R15,R15         WAS THE FILE FOUND ??                    WRI02130
         BNZ   ERROR6          NO, SOME OTHER FSSTATE ERROR             WRI02140
*    OK, HIS ORIGINAL FILE ID IS BEING USED BY ANOTHER FILE.  WE'RE     WRI02150
*    GOING TO HAVE TO START LOOPING, CHANGING THE FILENAME, UNTIL WE    WRI02160
*    FIND AN UNUSED ONE.  FIND WHERE TO PUT THE 000'S IN HIS FILE NAME. WRI02170
         LA    R9,PARM4+1      START AT SECOND CHARACTER OF FILENAME    WRI02180
         LA    R0,1            INCREMENT 1 CHARACTER AT A TIME AND      WRI02190
         LA    R1,PARM4+4      QUIT AFTER THE FOURTH CHARACTER          WRI02200
UP2      CLI   0(R9),C' '    FIND THE FIRST BLANK IN THE FILENAME OR    WRI02210
         BE    CON131        THE FIFTH CHARACTER, WHICHEVER COMES FIRST WRI02220
         BXLE  R9,R0,UP2                                                WRI02230
CON131   DS    0H          NOW, R9 = ADDRESS OF WHERE TO PUT THE 000'S  WRI02240
         MVC   VL,=PL4'0'  INITIALIZE VERSION LEVEL COUNTER TO ZEROES   WRI02250
CON132   DS    0H                                                       WRI02260
         UNPK  TEMPA,VL            UNPACK VERSION LEVEL COUNTER         WRI02270
         OI    TEMPA+7,X'F0'                                            WRI02280
         MVC   0(3,R9),TEMPA+5     MOVE IN THE LAST 3 CHARACTERS        WRI02290
         FSSTATE (R8)              CHECK FOR THE EXISTENCE OF THIS FILE WRI02300
         LTR   R15,R15             IS THIS FILENAME FREE ??             WRI02310
         BNZ   CON139              YEP, FINALLY FOUND ONE WE CAN USE.   WRI02320
         AP    VL,=PL1'1'          ELSE INCREMENT THE VERSION LEVEL     WRI02330
         CP    VL,=P'999'          ARE WE AT THE END YET ??             WRI02340
         BNH   CON132              NOPE, STILL OK.  KEEP CHECKING.      WRI02350
         B     ERROR8     ALL 1,001 FILE ID'S ARE USED UP.  REJECT.     WRI02360
CON139   DS    0H                                                       WRI02370
         B     CON200     WE'VE GOT THE FILE ID.  CONTINUE ON           WRI02380
*   CONTINUE CHECKING FOR VALID SUBFUNCTIONS.                           WRI02390
CON140   DS    0H                                                       WRI02400
         CLC   PARM2,=CL8'APPEND'   CHECK FOR WRITE AND APPEND          WRI02410
         BNE   CON150                                                   WRI02420
         OI    RITFLAGB,APPEND                                          WRI02430
*   THERE'S NO CHECKING NEEDED HERE.  IF THE FILE EXISTS, GREAT,        WRI02440
*   EVERYTHING'S FINE.  IF IT DOESN'T EXIST, THEN THE FILE WILL BE      WRI02450
*   CREATED.  EITHER WAY, THINGS WILL WORK AS EXPECTED.  LET THE        WRI02460
*   FSOPEN MACRO DETERMINE IF THIS FILE ID IS VALID OR NOT.             WRI02470
         B     CON200               EVERYTHING'S GREAT.  CONTINUE ON    WRI02480
*   CONTINUE CHECKING FOR VALID SUBFUNCTIONS.  ONE LAST CHANCE.         WRI02490
CON150   DS    0H                                                       WRI02500
         CLC   PARM2,=CL8'DA'       CHECK FOR DIRECT ACCESS WRITE       WRI02510
         BNE   ERROR9               THAT WAS THE LAST CHANCE, BUB       WRI02520
         OI    RITFLAGB,DA                                              WRI02530
*   MAKE SURE THIS FILE EXISTS.  IF NOT, HE BLEW IT.                    WRI02540
*   IF IT DOES EXIST, CHECK TO MAKE THIS IS A FIXED LENGTH FILE.        WRI02550
*   IF NOT, THEN REJECT THIS REQUEST.  I'M NOT GOING TO SUPPORT         WRI02560
*   WRITING IN THE MIDDLE OF A VARIABLE LENGTH FILE.  TO MESSY.         WRI02570
*   IF WE GOT THIS FAR, CHECK THE STARTING RECORD NUMBER.  IF BIGGER    WRI02580
*   THAN THE NUMBER OF RECORDS IN THE FILE BY MORE THAN ONE, THEN       WRI02590
*   HE BLEW IT (I WILL ALLOW HIM TO START AT THE END OF THE FILE).      WRI02600
         LA    R8,PARM4        GET ADDRESS OF FILE ID (FN FT FM)        WRI02610
         FSSTATE (R8)          DOES THIS FILE EXIST ??                  WRI02620
         LTR   R15,R15                                                  WRI02630
         BZ    CON151          YES IT DOES.  CONTINUE ON.               WRI02640
         C     R15,=F'28'      WAS THE FILE NOT FOUND ??  (EXPECTED)    WRI02650
         BE    ERROR10         YES, IT WAS NOT FOUND.                   WRI02660
         C     R15,=F'20'      INVALID FILE ID ??                       WRI02670
         BE    ERROR5          YEP                                      WRI02680
         B     ERROR6          SOME OTHER ERROR WITH FSSTATE            WRI02690
CON151   DS    0H                                                       WRI02700
         USING FSTD,R3         R1 IS POINTING TO THE FILE STATUS TABLE  WRI02710
         LR    R3,R1           SHIFT FST BASE REGISTER TO R3            WRI02720
         CLI   FSTRECFM,C'F'   MAKE SURE THIS IS A FIXED-LENGTH FILE    WRI02730
         BNE   ERROR11         WE DON'T HANDLE VARIABLE-LENGTH FILES    WRI02740
*    CONVERT THE STARTING RECORD NUMBER TO A DECIMAL NUMBER             WRI02750
         LA    R1,PARM10       PARM10 IS THE STARTING RECORD NUMBER     WRI02760
         L     R15,ACONDEC     GO TO THE CONVERT-TO-DECIMAL ROUTINE     WRI02770
         BALR  R14,R15                                                  WRI02780
         LTR   R15,R15         HOW'D THINGS GO ??                       WRI02790
         BNZ   ERROR12         ERROR IF ALL BLANK OR INVALID            WRI02800
         LTR   R0,R0           IF HE SAID START AT RECORD NUMBER 0,     WRI02810
         BNZ   CON154          HE REALLY MEANS START AT RECORD 1        WRI02820
         LA    R0,1                                                     WRI02830
CON154   EQU   *                                                        WRI02840
         LH    R1,FSTRECCT     ADD ONE TO THE NUMBER OF RECORDS         WRI02850
         LA    R1,1(R1)        IN THE FILE.                             WRI02860
         CR    R0,R1           IS THE STARTING RECORD NUMBER GREATER    WRI02870
         BH    ERROR13         THAN THE NUMBER OF RECORDS + 1 ??        WRI02880
         ST    R0,STARTRCD     SAVE THE STARTING RECORD NUMBER          WRI02890
         DROP  R3              DON'T NEED THE FST ANYMORE               WRI02900
CON200   EQU   *                                                        WRI02910
*    FIND OUT HOW MANY BYTES ARE COMING OVER.                           WRI02920
         LA    R1,PARM3        PARM3 IS THE BYTE COUNT                  WRI02930
         L     R15,ACONDEC     GO TO THE CONVERT-TO-DECIMAL ROUTINE     WRI02940
         BALR  R14,R15                                                  WRI02950
         LTR   R15,R15         DID THE BYTE COUNT CONVERT OK ??         WRI02960
         BNZ   ERROR14         ERROR IF NOT                             WRI02970
         LTR   R0,R0           IT'S ALSO INVALID IF ZERO                WRI02980
         BZ    ERROR14                                                  WRI02990
         ST    R0,BYTECNT      IF IT'S OK, THEN STORE IT AWAY           WRI03000
*    IS THIS INPUT GOING TO BE IN FIXED, VARIABLE, OR SOURCE FORMAT ??  WRI03010
         CLI   PARM8,C'S'      PARM8 DETERMINES INPUT FORMAT            WRI03020
         BNE   CON210          BRANCH IF NOT IN SOURCE FORMAT           WRI03030
         OI    RITFLAGA,SFORMAT     ELSE, IT'LL BE IN SOURCE FORMAT     WRI03040
         B     CON212                     CONTINUE ON                   WRI03050
*    IS THIS INPUT GOING TO BE IN FIXED OR VARIABLE FORMAT ??           WRI03060
CON210   DS    0H                                                       WRI03070
         CLI   PARM8,C'V'      PARM8 DETERMINES FIXED OR VARIABLE       WRI03080
         BE    CON212          BRANCH IF IT'LL BE IN VARIABLE FORMAT    WRI03090
         OI    RITFLAGA,FIXEDUTS    ELSE, IT'LL BE IN FIXED FORMAT      WRI03100
*    FIND OUT WHAT THE INPUT DATA'S LRECL (OR BLOCKING FACTOR) IS.      WRI03110
         LA    R1,PARM9        PARM 9 IS THE RECORD BLOCKING FACTOR     WRI03120
         L     R15,ACONDEC     GO TO THE CONVERT-TO-DECIMAL ROUTINE     WRI03130
         BALR  R14,R15                                                  WRI03140
         LTR   R15,R15               DID IT CONVERT OK ??               WRI03150
         BNZ   ERROR15               ERROR IF NOT                       WRI03160
         LTR   R0,R0                 IT'S ALSO INVALID IF ZERO          WRI03170
         BZ    ERROR15                                                  WRI03180
         ST    R0,UTSLRECL           IF IT'S OK, THEN STORE IT AWAY     WRI03190
CON212   DS    0H                                                       WRI03200
*    NOW GO GET THE SPECIFIED NUMBER OF BYTES FROM THE UTS.             WRI03210
         L     R0,BYTECNT            NUMBER OF BYTES FROM THE UTS       WRI03220
         L     R1,ABUFFER            BUFFER ADDRESS                     WRI03230
         L     R15,AREADUTS                                             WRI03240
         BALR  R14,R15                                                  WRI03250
*    ESTABLISH THE OUTPUT BUFFER.  THIS'LL BE RIGHT AFTER ALL THE       WRI03260
*    INPUT DATA AND WILL BE USED TO MOVE A RECORD TO, PAD IT TO THE     WRI03270
*    LRECL OF THE CMS FILE, AND WRITE IT OUT TO THE CMS FILE.           WRI03280
         L     R9,ABUFFER      START OF INPUT BUFFER                    WRI03290
         A     R9,BYTECNT    + NUMBER OF BYTES IN INPUT                 WRI03300
         ST    R9,OUTBUFR    = START OF OUTPUT BUFFER                   WRI03310
*    OPEN THE CMS FILE.  IF THIS HAPPENS TO BE A NEW FILE, THEN         WRI03320
*    SET UP THE RECORD FORMAT (FIXED OR VARIABLE) AND THE LRECL OF      WRI03330
*    THE CMS FILE.  MAKE IT THE SAME AS THE INPUT DATA FORMAT.          WRI03340
         IC    R10,=C'V'              ASSUME VARIABLE LENGTH UNTIL      WRI03350
         LA    R9,0                   PROVEN WRONG                      WRI03360
         TM    RITFLAGA,FIXEDUTS      WAS I RIGHT ??                    WRI03370
         BNO   CON215                 YEP, IT IS GOING TO BE VARIABLE   WRI03380
         IC    R10,=C'F'              OTHERWISE CHANGE TO FIXED FORMAT  WRI03390
         L     R9,UTSLRECL            AND USE THE CORRECT LRECL         WRI03400
CON215   DS    0H                                                       WRI03410
         MVC   PADCHAR,PARM6+7        REMEMBER THE PAD CHARACTER        WRI03420
*    R9  = LOGICAL RECORD LENGTH                                        WRI03430
*    R10 = C'F' IF FIXED FORMAT, ELSE C'V' FOR VARIABLE FORMAT          WRI03440
         USING FSCBD,R3        TIME TO SET UP MY FSCB BASE REGISTER     WRI03450
         LA    R3,MYFSCB                                                WRI03460
         LA    R8,PARM4        GET FILE ID (FILE NAME, TYPE, AND MODE)  WRI03470
         FSOPEN (R8),FSCB=(R3),RECFM=(R10),BSIZE=(R9)                   WRI03480
         LTR   R15,R15               DID IT WORK ??                     WRI03490
         BZ    CON305                YEA, WE'RE ALL SET.                WRI03500
         C     R15,=F'28'            IS THIS A NEW FILE ??              WRI03510
         BE    CON300                YEP, REMEMBER THAT FACT.           WRI03520
         C     R15,=F'20'            INVALID FILE ID ??                 WRI03530
         BE    ERROR5                YEP                                WRI03540
         B     ERROR16               NO, SOME OTHER ERROR WITH FSOPEN.  WRI03550
CON300   DS    0H                                                       WRI03560
         OI    RITFLAGA,NEW          REMEMBER WE'RE CREATING A NEW FILE WRI03570
CON305   DS    0H        THE FILE IS OPENED, AND EVERYTHING'S GROOVY    WRI03580
         CLI   FSCBFV,C'V'           IS THE CMS FILE VARIABLE LENGTH ?? WRI03590
         BE    CON310                SKIP NEXT INSTRUCTION IF SO        WRI03600
         OI    RITFLAGA,FIXEDCMS     REMEMBER THE CMS FILE IS FIXED     WRI03610
CON310   DS    0H                                                       WRI03620
*    IF THIS IS A DA WRITE, THEN DO A FSPOINT TO START WRITING          WRI03630
*    AT THE CORRECT STARTING RECORD NUMBER.                             WRI03640
         TM    RITFLAGB,DA           IS IT A DA WRITE ??                WRI03650
         BNO   CON400                NOPE, CONTINUE ON.                 WRI03660
         L     R9,STARTRCD           GET THE STARTING RECORD NUMBER     WRI03670
         FSPOINT FSCB=MYFSCB,WRPNT=(R9)                                 WRI03680
         LTR   R15,R15               THERE SHOULD NEVER BE ANY ERROR,   WRI03690
         BNZ   ERROR17               BUT JUST IN CASE ....              WRI03700
CON400   DS    0H                                                       WRI03710
*                                                                       WRI03720
*    NOW START DOING THE WRITING INTO THE CMS FILE.                     WRI03730
*                                                                       WRI03740
         L     R9,ABUFFER         COMPUTE AND SAVE THE ADDRESS OF THE   WRI03750
         A     R9,BYTECNT         FIRST BYTE OUTSIDE THE INPUT BUFFER   WRI03760
         ST    R9,EOBUFFER                                              WRI03770
         XC    RCDCNTR,RCDCNTR    SET TOTAL RECORDS WRITTEN IN FILE=0   WRI03780
         SR    R7,R7              INITIALIZE # RECORDS WRITTEN THUS FAR WRI03790
         TM    RITFLAGA,SFORMAT      UTS SOURCE FORMAT ??               WRI03800
         BO    CON410                YES, GO HANDLE THAT FORMAT         WRI03810
         L     R8,BYTECNT   INITIALIZE # BYTES LEFT IN INPUT BUFFER     WRI03820
         L     R9,ABUFFER   INITIALIZE INPUT BUFFER POINTER             WRI03830
         B     RITELOOP     CONTINUE ON                                 WRI03840
CON410   DS    0H                                                       WRI03850
         L     R9,ABUFFER         INITIALIZE NEXT BLOCK ADDRESS         WRI03860
         B     CON411             SKIP NEXT LINE FIRST TIME THROUGH     WRI03870
DONEXTB  DS    0H                                                       WRI03880
         L     R9,NEXTBLOK  SET INPUT BUFFER POINTER TO START OF BLOCK  WRI03890
CON411   LA    R10,1740(R9)     COMPUTE ADDRESS OF FOLLOWING BLOCK      WRI03900
         ST    R10,NEXTBLOK     REMEMBER START OF NEXT BLOCK            WRI03910
         MVC   SAVERCNT,1722(R9)    SAVE COUNT OF # RCDS IN THIS BLOCK  WRI03920
         LH    R8,8(R9)     INITIALIZE # BYTES LEFT IN THIS BLOCK       WRI03930
         SLL   R8,1         MULTIPLY BY 2 TO GET BYTE COUNT             WRI03940
         LA    R9,10(R9)    SET INPUT BUFFER POINTER TO START OF DATA   WRI03950
         A     R7,RCDCNTR   ADD NUMBER RECORDS WRITTEN IN LAST BLOCK    WRI03960
         ST    R7,RCDCNTR   TO TOTAL WRITTEN IN CMS FILE THUS FAR       WRI03970
         SR    R7,R7        SET # RCDS WRITTEN THIS BLOCK THUS FAR = 0  WRI03980
RITELOOP DS    0H                                                       WRI03990
         C     R9,EOBUFFER      ARE WE PAST END OF THE INPUT BUFFER ??  WRI04000
         BNL   EXITLOOP                                                 WRI04010
*    FIRST FIND THE LENGTH OF THE INPUT RECORD.  PUT IN R10             WRI04020
         TM    RITFLAGA,FIXEDUTS     IS THE INPUT IN FIXED FORMAT ??    WRI04030
         BNO   CON413                NOPE, GO HANDLE VARIABLE LENGTH    WRI04040
         L     R10,UTSLRECL     INPUT RECORD LENGTH IS ALWAYS THE SAME  WRI04050
         B     CON419           CONTINUE ON                             WRI04060
CON413   DS    0H                                                       WRI04070
         SH    R8,=H'2'         DECREMENT 2 BYTES FOR RECORD LENGTH     WRI04080
         BM    ERROR18          THERE WASN'T 2 BYTES THERE TO TAKE      WRI04090
         CLC   0(2,R9),=X'FFFF'   IS THIS AN END-OF-BLOCK MARKER ??     WRI04100
         BE    QUITLOOP           ABORT OUT OF THIS WRITE LOOP IF SO    WRI04110
         TM    RITFLAGA,SFORMAT                                         WRI04120
         BNO   CON414                                                   WRI04130
         CLC   0(2,R9),=X'0000'     IF SOURCE FORMAT AND I SEE A        WRI04140
         BE    DONEXTB              ZERO LENGTH, GO TO NEXT BLOCK.      WRI04150
CON414   DS    0H                                                       WRI04160
         CLC   0(2,R9),=X'0000'     IF NOT SOURCE FORMAT & ZERO LENGTH, WRI04170
         BE    QUITLOOP             THEN THAT'S AN END-OF-FILE MARKER.  WRI04180
*    IF THE HIGH ORDER BIT IN THE RECORD LENGTH IS ON, THEN THIS RECORD WRI04190
*    GETS "TABBED" OVER 6 POSITIONS.  SO I'LL HAVE TO INSERT THE 6      WRI04200
*    BLANKS IN THE RECORD.  NOTICE THAT A LENGTH OF X'8000' WILL RESULT WRI04210
*    IN A RECORD WITH 6 BLANKS IN IT.                                   WRI04220
         TM    0(R9),X'80'      IS THE TAB BIT ON IN THE INPUT ??       WRI04230
         BNO   CON418           NO, CONTINUE ON                         WRI04240
         NI    0(R9),X'7F'     TURN IT OFF BEFORE YOU PICK IT UP        WRI04250
         LH    R10,0(R9)       GET THE INPUT RECORD'S LENGTH            WRI04260
         SLL   R10,1           MULTIPLY BY 2 TO GET # BYTES IN RECORD   WRI04270
         LA    R10,6(R10)      ADD 6 MORE 'CAUSE OF THE BLANKS          WRI04280
         SH    R9,=H'4'        BACK UP INPUT BUFFER TO ALLOW FOR BLANKS WRI04290
         MVC   0(6,R9),=CL6' ' MOVE IN 6 BLANKS 'CAUSE OF THE TAB       WRI04300
         LA    R8,6(R8)        THERE'S 6 MORE BYTES IN INPUT NOW        WRI04310
         B     CON419                                                   WRI04320
CON418   DS    0H    IT'S NOT A TABBED VARIABLE LENGTH INPUT RECORD     WRI04330
*                    IT'S JUST A NORMAL ONE.  GET THIS RECORD'S LENGTH  WRI04340
         LH    R10,0(R9)                                                WRI04350
         SLL   R10,1            MULTIPLY BY 2 TO GET # BYTES IN RECORD  WRI04360
         LA    R9,2(R9)         BUMP PAST LENGTH IN INPUT STREAM        WRI04370
CON419   DS    0H                                                       WRI04380
*    AT THIS POINT  R8 = NUMBER OF BYTES LEFT IN INPUT STREAM AFTER     WRI04390
*                        GETTING THE LENGTH (MIGHT BE ZERO)             WRI04400
*                   R9 = STARTING ADDRESS OF THE INPUT DATA             WRI04410
*                  R10 = NUMBER OF BYTES IN THIS INPUT RECORD           WRI04420
         C     R10,BIGGEST      IS THIS THE BIGGEST RECORD THUS FAR ??  WRI04430
         BNH   CON420           NOPE, DON'T EXCHANGE                    WRI04440
         ST    R10,BIGGEST      ELSE WE'VE GOT A NEW BIGGEST RECORD     WRI04450
CON420   DS    0H                                                       WRI04460
*    NOW, GET THE OUTPUT RECORD'S LENGTH, WHICH IS GOING TO DEPEND ON   WRI04470
*    THE CMS FILE'S RECORD FORMAT.                                      WRI04480
         LR    R12,R10             ASSUME OUTPUT LRECL = INPUT LRECL    WRI04490
         TM    RITFLAGA,FIXEDCMS   I.E. ASSUME VARIABLE LENGTH CMS FILE WRI04500
         BNO   CON421              BRANCH IF I GUESSED RIGHT            WRI04510
         L     R12,FSCBSIZE        ELSE PICK UP THE OUTPUT RECORD SIZE  WRI04520
         CR    R10,R12       IS THE INPUT RECORD > THE OUTPUT RECORD ?? WRI04530
         BNH   CON421        IF NOT, THEN IT WON'T GET TRUNCATED        WRI04540
         OI    RITFLAGA,TRUNC      REMEMBER WE'VE TRUNCATED A RECORD    WRI04550
CON421   DS    0H                                                       WRI04560
*    AT THIS POINT  R8 = NUMBER OF BYTES LEFT IN INPUT STREAM AFTER     WRI04570
*                        GETTING THE LENGTH (STILL MIGHT BE ZERO)       WRI04580
*                   R9 = STARTING ADDRESS OF THE INPUT DATA             WRI04590
*                  R10 = NUMBER OF BYTES IN THIS INPUT RECORD           WRI04600
*                  R12 = NUMBER OF BYTES IN THE OUTPUT RECORD           WRI04610
*              OUTBUFR = STARTING ADDRESS OF THE OUTPUT BUFFER          WRI04620
*    NOW MOVE THIS INPUT RECORD TO THE OUTPUT BUFFER.  IF THE RECORD    WRI04630
*    IS GOING TO NEED PADDING, THE MVCL INSTRUCTION WILL DO IT FOR US.  WRI04640
*    FOR THE MVCL,                                                      WRI04650
*        R14 = DESTINATION ADDRESS (OUTBUFR)                            WRI04660
*        R15 = DESTINATION LENGTH (R12)                                 WRI04670
*        R0  = SOURCE ADDRESS (R9)                                      WRI04680
*        R1  = PAD CHARACTER (PADCHAR) IN THE HIGH ORDER BYTE AND       WRI04690
*              THE SOURCE LENGTH IN THE OTHER THREE BYTES               WRI04700
*              (SMALLER OF R10 AND R8).                                 WRI04710
         L     R14,OUTBUFR     GET THE ADDRESS OF THE OUTPUT BUFFER     WRI04720
         LR    R15,R12         AND THE OUTPUT RECORD LENGTH             WRI04730
         LR    R0,R9           SHIFT INPUT RECORD STARTING ADDRESS      WRI04740
         LR    R1,R10          GET LENGTH OF INPUT RECORD               WRI04750
         CR    R10,R8          HAVE WE RUN OUT OF INPUT DATA YET ??     WRI04760
         BNH   CON422          NOPE, WE'RE STILL OK                     WRI04770
         LR    R1,R8           ELSE WE DON'T HAVE ENOUGH INPUT DATA     WRI04780
         OI    RITFLAGA,LASTINC      TO COMPLETE THIS OUTPUT RECORD     WRI04790
CON422   DS    0H                                                       WRI04800
*    R1 = LENGTH OF THIS INPUT RECORD.  UPDATE OUR INPUT BUFFER         WRI04810
         SR    R8,R1           POINTERS BEFORE PUTTING IN THE PAD CHAR. WRI04820
         AR    R9,R1           POINT TO THE NEXT INPUT RECORD           WRI04830
 TM TEST0108,TEST3                                                      WRI04840
 BNO GOGO                                                               WRI04850
 STM R13,R2,JUNK                                                        WRI04860
 LINEDIT TEXT='MVCL TO ......, LENGTH = ..........',SUB=(HEXA,JUNK+4,DE-WRI04870
               CA,JUNK+8),RENT=NO                                       WRI04880
 LINEDIT TEXT='   FROM ......, LENGTH = ..........',SUB=(HEXA,JUNK+12,D-WRI04890
               ECA,JUNK+16),RENT=NO                                     WRI04900
  LM R13,R2,JUNK                                                        WRI04910
  B GOGO                                                                WRI04920
JUNK DS 6F                                                              WRI04930
GOGO DS  0H                                                             WRI04940
         ICM   R1,B'1000',PADCHAR        GET THE PAD CHARACTER          WRI04950
         MVCL  R14,R0                    PREPARE THE OUTPUT RECORD      WRI04960
*    AT THIS POINT  OUTBUFR = STARTING ADDRESS OF THE OUTPUT RECORD     WRI04970
*                       R8  = NUMBER OF BYTES REMAINING IN THE INPUT    WRI04980
*                             BUFFER AFTER THIS INPUT RECORD            WRI04990
*                             (MIGHT BE LESS THAN OR EQUAL TO ZERO)     WRI05000
*                       R9  = ADDRESS OF NEXT INPUT RECORD              WRI05010
*                             (IF THERE IS ONE)                         WRI05020
*                       R12 = LENGTH OF THE OUTPUT RECORD               WRI05030
         L     R13,OUTBUFR                                              WRI05040
 TM TEST0108,TEST4                                                      WRI05050
 BNO GOGO2                                                              WRI05060
         LINEDIT TEXT='I''M GOING TO WRITE ...... BYTES STARTING AT ...-WRI05070
               ...',SUB=(DEC,(R12),HEX,(R13)),RENT=NO                   WRI05080
GOGO2    DS    0H                                                       WRI05090
 TM TEST0108,TEST8                                                      WRI05100
 BNO GOGO3                                                              WRI05110
         LINEDIT TEXT='THIS IS RECORD NUMBER .... IN THIS BLOCK AND THE-WRI05120
               RE''S ..... BYTES LEFT TO DO',SUB=(DEC,(R7),DEC,(R8)),RE-WRI05130
               NT=NO                                                    WRI05140
GOGO3    DS    0H                                                       WRI05150
         FSWRITE FSCB=(R3),BUFFER=(R13),BSIZE=(R12)                     WRI05160
         LTR   R15,R15         I TRUST EVERYTHING WENT OK.  DID IT ??   WRI05170
         BZ    CON500          GOOD.                                    WRI05180
         C     R15,=F'13'      WAS THE DISK FULL ??                     WRI05190
         BE    ERROR19         GO HANDLE FULL DISK                      WRI05200
         C     R15,=F'20'      WAS THE FILE NAME INVALID OR BLANK ??    WRI05210
         BE    ERROR20         BLANK FILE NAME GETS CAUGHT HERE.        WRI05220
         C     R15,=F'21'      WAS THE FILE TYPE INVALID OR BLANK ??    WRI05230
         BE    ERROR20         BLANK FILE TYPE GETS CAUGHT HERE.        WRI05240
         C     R15,=F'12'      IS THIS A READ ONLY DISK, MAYBE ??       WRI05250
         BE    ERROR21         AH, THAT'S IT.                           WRI05260
         B     ERROR22         IT THOSE AREN'T IT, THEN I GIVE UP.      WRI05270
CON500   DS    0H                                                       WRI05280
         LA    R7,1(R7)    BUMP RECORD COUNTER                          WRI05290
         TM    RITFLAGA,SFORMAT      UTS SOURCE FORMAT ??               WRI05300
         BO    CON510                YES, GO HANDLE THAT FORMAT         WRI05310
         C     R9,EOBUFFER      ARE WE PAST END OF THE INPUT BUFFER ??  WRI05320
         BL    RITELOOP         NO, CONTINUE WRITING DATA TO CMS FILE.  WRI05330
         B     EXITLOOP         ELSE, EXIT THIS LOOP.  WE'RE DONE.      WRI05340
CON510   DS    0H                                                       WRI05350
         CH    R7,SAVERCNT   HAVE WE DONE ALL THE RCDS IN THIS BLOCK ?? WRI05360
         BNL   DONEXTB       YES, GO DO THE NEXT BLOCK.                 WRI05370
         LTR   R8,R8       IS THERE ANY MORE DATA IN THIS BLOCK ??      WRI05380
         BNP   DONEXTB     NO, GO DO NEXT BLOCK (IF THERE IS ONE).      WRI05390
         B     RITELOOP    ELSE, CONTINUE WRITING INTO CMS FILE.        WRI05400
QUITLOOP DS    0H           WE FOUND A END-OF-FILE OR END-OF-BLOCK      WRI05410
         LTR   R8,R8        DID WE END EXACTLY AT THE END OF THE INPUT? WRI05420
         BZ    CON600       YES, DON'T CALL IT AN ERROR, ELSE IT'S A    WRI05430
         MVC   RETCODE,=X'00000004'     PREMATURE EOF OR EOB            WRI05440
CON600   DS    0H                                                       WRI05450
EXITLOOP DS    0H                                                       WRI05460
         TM    RITFLAGA,LASTINC        IF LAST INPUT RECORD WAS CHOPPED WRI05470
         BNO   LEAVE                                                    WRI05480
         CLC   RETCODE,=F'0'           AND NO OTHER ERROR OCCURRED,     WRI05490
         BNE   LEAVE                                                    WRI05500
         MVC   RETCODE,=X'00000008'    LAST INPUT RECORD WAS INCOMPLETE WRI05510
LEAVE    DS    0H                                                       WRI05520
         A     R7,RCDCNTR       ADD RECORDS WRITTEN THIS BLOCK TO TOTAL WRI05530
         ST    R7,RCDCNTR       REMEMBER TOTAL # RECORDS YOU WROTE      WRI05540
         FSCLOSE FSCB=MYFSCB                                            WRI05550
 TM TEST0108,TEST5                                                      WRI05560
 BNO SKIP2                                                              WRI05570
         LINEDIT TEXT='THE FILE JUST WRITTEN WAS ........ ........ .',S-WRI05580
               UB=(CHARA,PARM4,CHARA,PARM5,CHARA,PARM6),RENT=NO         WRI05590
SKIP2    EQU   *                                                        WRI05600
*    PREPARE REPLY CONTROL BLOCK.  YOU'LL ONLY BE HERE IF THINGS        WRI05610
*    WENT OK WITH NO ERRORS OR PREMATURE END-OF-FILE OR END-OF-BLOCK.   WRI05620
*    1)  IF THIS WAS A DA WRITE, ASSUME HE'S GOING TO CONTINUE          WRI05630
*        TO DA WRITE INTO THIS FILE RIGHT AFTER WHERE HE LEFT OFF.      WRI05640
*        CALCULATE THE STARTING RECORD NUMBER FOR THE NEXT DA           WRI05650
*        WRITE, WHICH'LL BE THE STARTING RECORD NUMBER FOR THIS         WRI05660
*        WRITE + THE NUMBER OF RECORDS I WROTE THIS TIME.               WRI05670
*        CONVERT THIS NUMBER TO EBCDIC AND PUT IT IN PARM10.            WRI05680
*    2)  IF THIS WASN'T A DA WRITE, REPLACE THE SUBFUNCTION             WRI05690
*        WITH 'APPEND', ASSUMING HE'LL WANT TO APPEND, OR               WRI05700
*        CONTINUE TO APPEND, TO THE END OF THIS FILE.                   WRI05710
*    3)  PUT THE CMS FILE'S CHARACTERISTICS (FIXED OR VARIABLE LENGTH,  WRI05720
*        LRECL, AND NUMBER OF RECORDS) IN PARM14.  ALSO PUT THE SIZE    WRI05730
*        OF THE BIGGEST RECORD I FOUND IN THE INPUT STREAM THERE.       WRI05740
*    4)  PUT THE RETURN CODE IN PLACE AND SET THE NUMBER OF DATA        WRI05750
*        BYTES FOLLOWING THIS CONTROL BLOCK TO ZERO, BOTH IN            WRI05760
*        PARM15.                                                        WRI05770
*    |       |       |       |       |       |       |       |       |  WRI05780
*    |       |       |       |       |       |       |       |       |  WRI05790
*    |---------------------------------------------------------------|  WRI05800
*    |             TODAY'S DATE IN MM/DD/YY FORMAT                   |  WRI05810
*    |---------------------------------------------------------------|  WRI05820
*    |             CURRENT TIME IN HH:MM:SS FORMAT                   |  WRI05830
*    |---------------------------------------------------------------|  WRI05840
*    | F | V | FREE  |    CMS FILE   |  # RECORDS IN |    BIGGEST    |  WRI05850
*    |       |       |     LRECL     |    CMS FILE   |  INPUT RECORD |  WRI05860
*    |---------------------------------------------------------------|  WRI05870
*    |  RETCODE  |    NUMBER OF DATA BYTES FOLLOWING THIS = 0        |  WRI05880
*    |---------------------------------------------------------------|  WRI05890
         TM    RITFLAGB,DA                                              WRI05900
         BO    CON900              GO DO WHAT YOU HAVE TO FOR DA WRITE  WRI05910
         MVC   PARM2,=CL8'APPEND'  ASSUME NEXT WRITE WILL BE AN APPEND  WRI05920
         B     CON910                                                   WRI05930
CON900   EQU   *                                                        WRI05940
         L     R12,STARTRCD        COMPUTE THE NEXT STARTING RECORD #   WRI05950
         A     R12,RCDCNTR                                              WRI05960
         CVD   R12,TEMPA                                                WRI05970
         OI    TEMPA+7,X'0F'                                            WRI05980
         UNPK  TEMPB,TEMPA                                              WRI05990
         MVC   PARM10,TEMPB        MOVE IN STARTING RCD # FOR NEXT READ WRI06000
CON910   EQU   *                                                        WRI06010
         LA    R8,PARM4        GET ADDRESS OF FILE ID (FN FT FM)        WRI06020
         FSSTATE (R8)          GET THIS FILE'S FST ??                   WRI06030
         LTR   R15,R15         THE FSSTATE SHOULD NEVER FAIL.  WE JUST  WRI06040
         BZ    CON915          GOT THROUGH WRITING THIS FILE.  BUT IF   WRI06050
         XC    PARM14,PARM14   IT DOES, JUST ZERO OUT PARM14 AND        WRI06060
         B     CON990          CONTINUE ON                              WRI06070
CON915   EQU   *                                                        WRI06080
         USING FSTD,R1         R1 IS POINTING TO THE FILE STATUS TABLE  WRI06090
         MVC   PARM14(1),FSTRECFM         THIS'LL BE C'F' OR C'V'       WRI06100
         MVC   PARM14+2(2),FSTLRECL+2     CMS FILE'S LRECL              WRI06110
         MVC   PARM14+4(2),FSTRECCT       # RECORDS IN CMS FILE         WRI06120
         MVC   PARM14+6(2),BIGGEST+2      BIGGEST INPUT RECORD I SAW    WRI06130
         DROP  R1              DON'T NEED THE FST ANYMORE               WRI06140
CON990   EQU   *                                                        WRI06150
*    FALL THROUGH TO PUT THE DATE, TIME, AND THE RETURN CODE IN THE     WRI06160
*    REPLY CONTROL BLOCK, AND THEN GIVE IT TO THE UTS MACHINE.          WRI06170
*    IF THERE WAS AN ERROR, WE COME TO HERE.                            WRI06180
*                                                                       WRI06190
*-------------------------------------------------------------*         WRI06200
*    GET THE TIME AND DATE FROM CP                            *         WRI06210
*-------------------------------------------------------------*         WRI06220
         LA    R1,CPDATA           ADDRESS OF DATA FROM DIAG            WRI06230
         DIAG  R1,R0,X'000C'       REQUEST DATE AND TIME FROM CP        WRI06240
*-------------------------------------------------------------*         WRI06250
*    CPDATA IS NOW IN THE FORMAT OF                           *         WRI06260
*           DC    CL8'MM/DD/YY'                               *         WRI06270
*           DC    CL8'HH:MM:SS'                               *         WRI06280
*           DS    2D     THE REST IS JUNK                     *         WRI06290
*-------------------------------------------------------------*         WRI06300
         MVC   PARM12,CPDATA                                            WRI06310
         MVC   PARM13,CPDATA+8                                          WRI06320
 TM TEST0108,TEST6                                                      WRI06330
 BNO SKIP1                                                              WRI06340
         LINEDIT TEXT='AFTER ........ RECORDS, THE RETURN CODE IS .....-WRI06350
               .',SUB=(DECA,RCDCNTR,HEXA,RETCODE),RENT=NO               WRI06360
SKIP1    DS    0H                                                       WRI06370
         MVC   PARM15(2),RETCODE+2                                      WRI06380
         MVC   PARM15+2(6),=X'000000000000'                             WRI06390
         LA    R0,128           REPLY CONTROL BLOCK = 128 BYTES BIG     WRI06400
         LA    R1,PARM0         STARTING AT PARM0                       WRI06410
         L     R15,AWRITUTS                                             WRI06420
         BALR  R14,R15          GO GIVE THE REPLY TO THE UTS MACHINE    WRI06430
WRITEBYE EQU   *                                                        WRI06440
         LM    R0,R14,REGSAVE     RESTORE CALLER'S REGISTERS            WRI06450
         BR    R14                                                      WRI06460
         EJECT                                                          WRI06470
ERROR1   DS    0H                                                       WRI06480
*    WE GOT AN ERROR FROM THE ACCESS ROUTINE.                           WRI06490
*    IF R15 = 04, THEN THIS UTS WAS NOT FOUND IN THE UTSCB CHAIN        WRI06500
*                 (CAN NEVER HAPPEN).  RETCODE = X'6004'                WRI06510
*    IF R15 = 08, THEN THIS USER WAS NOT FOUND IN THE USERCB CHAIN      WRI06520
*                 FOR THIS UTS.  RETCODE = X'4004'                      WRI06530
*    IF R15 = 12, THEN THIS DISK WAS NOT FOUND IN THE DISKCB CHAIN      WRI06540
*                 FOR THIS USER.  RETCODE = X'100C'                     WRI06550
*    IF R15 = 16, THEN THE DISK WAS FOUND, BUT THERE'S NOT A MINIDISK   WRI06560
*                 AT THAT ADDRESS (CONFIGURATION ERROR).                WRI06570
*                 RETCODE = X'4008'                                     WRI06580
*    IF R15 = 20, THEN SOME OTHER ERROR HAPPENED IN THE ACCESS          WRI06590
*                 ROUTINE.  RETCODE = X'5004'                           WRI06600
*    IF R15 = ??, THEN PROGRAMMING ERROR.  RETCODE = X'7004'            WRI06610
         OI    RITFLAGA,ERROR          YES, WE HAD AN ERROR             WRI06620
         C     R15,=F'4'                                                WRI06630
         BNE   ERR1A                                                    WRI06640
         MVC   RETCODE,=X'00006004'    UTS NOT FOUND (CAN'T HAPPEN)     WRI06650
         B     ERR1BYE                                                  WRI06660
ERR1A    C     R15,=F'8'                                                WRI06670
         BNE   ERR1B                                                    WRI06680
         MVC   RETCODE,=X'00004004'    USER NOT FOUND IN USERCB CHAIN   WRI06690
         B     ERR1BYE                                                  WRI06700
ERR1B    C     R15,=F'12'                                               WRI06710
         BNE   ERR1C                                                    WRI06720
         MVC   RETCODE,=X'0000100C'    DISK NOT FOUND IN DISKCB CHAIN   WRI06730
         B     ERR1BYE                                                  WRI06740
ERR1C    C     R15,=F'16'                                               WRI06750
         BNE   ERR1D                                                    WRI06760
         MVC   RETCODE,=X'00004008'    NO MINIDISK AT THAT ADDRESS      WRI06770
         B     ERR1BYE                                                  WRI06780
ERR1D    C     R15,=F'20'                                               WRI06790
         BNE   ERR1E                                                    WRI06800
         MVC   RETCODE,=X'00005004'    OTHER ERROR IN ACCESS ROUTINE    WRI06810
         B     ERR1BYE                                                  WRI06820
ERR1E    MVC   RETCODE,=X'00007004'    PROGRAMMING ERROR                WRI06830
ERR1BYE  B     CON990                                                   WRI06840
         EJECT                                                          WRI06850
ERROR2   DS    0H                                                       WRI06860
*    THIS GUY ISN'T ALLOWED TO WRITE ON THIS DISK.  IT PROBABLY IS A    WRI06870
*    READ ONLY DISK (I.E. THE WRITE PASSWORD = 'NONE').  REJECT THIS    WRI06880
*    WRITE REQUEST WITH A RETURN CODE = X'2004'                         WRI06890
         MVC   RETCODE,=X'00002004'                                     WRI06900
         B     CON990                                                   WRI06910
         SPACE 3                                                        WRI06920
ERROR3   DS    0H                                                       WRI06930
*    THIS GUY GAVE ME THE WRONG PASSWORD FOR THIS DISK.  REJECT THIS    WRI06940
*    WRITE REQUEST WITH A RETURN CODE = X'1010'                         WRI06950
         MVC   RETCODE,=X'00001010'                                     WRI06960
         B     CON990                                                   WRI06970
         SPACE 3                                                        WRI06980
ERROR4   DS    0H                                                       WRI06990
*    HE TOLD ME TO CREATE THIS FILE BUT THE FILE ALREADY EXISTS.        WRI07000
*    REJECT THIS WRITE REQUEST WITH A RETURN CODE = X'201C'             WRI07010
         MVC   RETCODE,=X'0000201C'                                     WRI07020
         B     CON990                                                   WRI07030
         SPACE 3                                                        WRI07040
ERROR5   DS    0H                                                       WRI07050
*    THE FILE ID (FILE NAME OR FILE TYPE) HE GAVE ME HAS AN INVALID     WRI07060
*    CHARACTER IN IT.  REJECT THIS REQUEST WITH A RETURN CODE = X'1008' WRI07070
         MVC   RETCODE,=X'00001008'                                     WRI07080
         B     CON990                                                   WRI07090
         SPACE 3                                                        WRI07100
ERROR6   DS    0H                                                       WRI07110
*    WE GOT SOME KIND OF ERROR I DON'T UNDERSTAND WITH THE FSSTATE      WRI07120
*    MACRO.  REPORT THE ERROR WITH A RETURN CODE = X'5008'              WRI07130
         MVC   RETCODE,=X'00005008'                                     WRI07140
         B     CON990                                                   WRI07150
         SPACE 3                                                        WRI07160
ERROR7   DS    0H                                                       WRI07170
*    WE GOT SOME KIND OF ERROR WITH THE FSERASE MACRO.                  WRI07180
*    FIRST CHECK FOR A RETURN CODE = 36 = THIS IS A READ ONLY DISK.     WRI07190
*    IF SO,  REPORT THE ERROR WITH A RETURN CODE = X'400C'              WRI07200
*                       ELSE, IT'S A RETURN CODE = X'501C'              WRI07210
         C     R15,=F'36'         CHECK FOR READ ONLY DISK              WRI07220
         BE    ERR7CONT           GOTCHA                                WRI07230
         MVC   RETCODE,=X'0000501C'   WHO KNOWS WHAT IT IS ??           WRI07240
         B     CON990                                                   WRI07250
ERR7CONT MVC   RETCODE,=X'0000400C'                                     WRI07260
         B     CON990                                                   WRI07270
         SPACE 3                                                        WRI07280
ERROR8   DS    0H                                                       WRI07290
*    I COULDN'T FIND AN UNUSED FILENAME FOR THIS INCRVL WRITE REQUEST.  WRI07300
*    THE FOOL'S GOT OVER 1000 FILES ON THIS DISK ALL STARTING WITH THE  WRI07310
*    SAME CHARACTERS.  REPORT THE ERROR WITH A RETURN CODE = X'2018'    WRI07320
         MVC   RETCODE,=X'00002018'                                     WRI07330
         B     CON990                                                   WRI07340
         SPACE 3                                                        WRI07350
ERROR9   DS    0H                                                       WRI07360
*    INVALID SUBFUNCTION IN THIS REQUEST CONTROL BLOCK.  HE'S GOT       WRI07370
*    'WRITE' IN THE FUNCTION PARM (PARM1), BUT PARM2 IS NOT BLANK,      WRI07380
*    'CREATE', 'REPLACE', 'INCRVL', 'APPEND', OR 'DA'.  REJECT THIS     WRI07390
*    WRITE REQUEST WITH A RETURN CODE = X'101C'                         WRI07400
         MVC   RETCODE,=X'0000101C'                                     WRI07410
         B     CON990                                                   WRI07420
         SPACE 3                                                        WRI07430
ERROR10  DS    0H                                                       WRI07440
*    HE TRIED TO DO A DA WRITE AND THE CMS FILE DOES NOT EXIST.         WRI07450
*    WHAT CAN I DO NOW, BUT REJECT THIS WRITE REQUEST ??                WRI07460
*    RETURN CODE = X'2008'                                              WRI07470
         MVC   RETCODE,=X'00002008'                                     WRI07480
         B     CON990                                                   WRI07490
         SPACE 3                                                        WRI07500
ERROR11  DS    0H                                                       WRI07510
*    HE TRIED TO DO A DA WRITE INTO A VARIABLE LENGTH CMS FILE.  I      WRI07520
*    DON'T WANT TO SUPPORT THIS CAPABILITY.  IF HE WANTS TO DO THIS,    WRI07530
*    HE SHOULD MAKE THE CMS FILE FIXED LENGTH, NOT VARIABLE LENGTH.     WRI07540
*    REJECT THIS WRITE REQUEST WITH A RETURN CODE = X'2014'             WRI07550
         MVC   RETCODE,=X'00002014'                                     WRI07560
         B     CON990                                                   WRI07570
         SPACE 3                                                        WRI07580
ERROR12  DS    0H                                                       WRI07590
*    THIS IS A DA WRITE AND THE STARTING RECORD NUMBER IS MISSING OR    WRI07600
*    INVALID.  I DON'T WANT TO DEFAULT TO THE BEGINNING OR THE END OF   WRI07610
*    THE FILE, 'CAUSE IF HE WENT TO THE TROUBLE TO DO A DA WRITE, THEN  WRI07620
*    I'M NOT GOING TO TRY TO SECOND GUESS HIM.  JUST REJECT THIS WRITE  WRI07630
*    REQUEST WITH A RETURN CODE = X'1014'                               WRI07640
         MVC   RETCODE,=X'00001014'                                     WRI07650
         B     CON990                                                   WRI07660
         SPACE 3                                                        WRI07670
ERROR13  DS    0H                                                       WRI07680
*    THIS IS A DA WRITE AND THE STARTING RECORD NUMBER IS LARGER THAN   WRI07690
*    THE NUMBER OF RECORDS IN THIS CMS FILE + 1 (THAT + 1 IS TO ALLOW   WRI07700
*    HIM TO DA WRITE AFTER THE END OF THIS FILE (I.E. APPEND)).         WRI07710
*    REJECT THIS WRITE REQUEST WITH A RETURN CODE = X'200C'             WRI07720
         MVC   RETCODE,=X'0000200C'                                     WRI07730
         B     CON990                                                   WRI07740
         SPACE 3                                                        WRI07750
ERROR14  DS    0H                                                       WRI07760
*    PARM3, THE NUMBER OF BYTES THE UTS IS GOING TO SEND OVER IS        WRI07770
*    MISSING OR INVALID.                                                WRI07780
*    REJECT THIS WRITE REQUEST WITH A RETURN CODE = X'1004'             WRI07790
         MVC   RETCODE,=X'00001004'                                     WRI07800
         B     CON990                                                   WRI07810
         SPACE 3                                                        WRI07820
ERROR15  DS    0H                                                       WRI07830
*    THE UTS INPUT WAS GOING TO BE IN FIXED LENGTH FORMAT AND PARM9,    WRI07840
*    THE LRECL OF THE INPUT, WAS INVALID, MISSING, OR ZERO.             WRI07850
*    REJECT THIS WRITE REQUEST WITH A RETURN CODE = X'1018'             WRI07860
         MVC   RETCODE,=X'00001018'                                     WRI07870
         B     CON990                                                   WRI07880
         SPACE 3                                                        WRI07890
ERROR16  DS    0H                                                       WRI07900
*    WE GOT SOME KIND OF ERROR I DON'T UNDERSTAND WITH THE FSOPEN       WRI07910
*    MACRO.  REPORT THE ERROR WITH A RETURN CODE = X'500C'              WRI07920
         MVC   RETCODE,=X'0000500C'                                     WRI07930
         B     CON990                                                   WRI07940
         SPACE 3                                                        WRI07950
ERROR17  DS    0H                                                       WRI07960
*    WE GOT SOME KIND OF ERROR I DON'T UNDERSTAND WITH THE FSPOINT      WRI07970
*    MACRO.  THIS SHOULDN'T EVER HAPPEN 'CAUSE I CHECK FOR ALL          WRI07980
*    POSSIBLE ERRORS BEFORE I DO A FSPOINT.                             WRI07990
*    REPORT THE ERROR WITH A RETURN CODE = X'600C'                      WRI08000
         MVC   RETCODE,=X'0000600C'                                     WRI08010
         B     CON990                                                   WRI08020
         SPACE 3                                                        WRI08030
ERROR18  DS    0H                                                       WRI08040
*    I WAS GOING THROUGH THE VARIABLE LENGTH INPUT AND EVERYTHING       WRI08050
*    WAS FINE, UNTIL I CAME TO THE END OF THE INPUT AND THERE WAS       WRI08060
*    ONLY 1 BYTE LEFT.  NOT ENOUGH TO PICK UP THE LENGTH OF THE         WRI08070
*    NEXT RECORD.  REPORT THIS CONDITION WITH A RETURN CODE = X'2010'   WRI08080
         MVC   RETCODE,=X'00002010'                                     WRI08090
         B     LEAVE                                                    WRI08100
         SPACE 3                                                        WRI08110
ERROR19  DS    0H                                                       WRI08120
*    I FOUND OUT THIS DISK IS FULL WHEN I TRIED TO DO A WRITE TO IT.    WRI08130
*    REPORT THIS ERROR WITH A RETURN CODE = X'5024'                     WRI08140
         MVC   RETCODE,=X'00005024'                                     WRI08150
         B     LEAVE                                                    WRI08160
         SPACE 3                                                        WRI08170
ERROR20  DS    0H                                                       WRI08180
*    THE FSWRITE DETECTED AN INVALID FILE ID (EITHER FILE NAME OR FILE  WRI08190
*    TYPE).  THIS ERROR SHOULD HAVE ALREADY BEEN CAUGHT BEFORE A WRITE  WRI08200
*    WAS ATTEMPTED TO THIS FILE, BUT A BLANK FN OR FT DOES GET THIS     WRI08210
*    FAR.  REJECT THIS REQUEST WITH A RETURN CODE = X'1008' AND GO TO   WRI08220
*    LEAVE TO CLOSE THE FILE, NOT CON990 LIKE ERROR5 DID.               WRI08230
         MVC   RETCODE,=X'00001008'                                     WRI08240
         B     LEAVE                                                    WRI08250
         SPACE 3                                                        WRI08260
ERROR21  DS    0H                                                       WRI08270
*    THIS GUY TRIED TO WRITE TO A FILE THAT I ONLY HAVE READ ACCESS     WRI08280
*    TO.  IT'S ONLY A READ ONLY DISK TO ME, SO IT CAN'T BE READ/WRITE   WRI08290
*    TO HIM.  THIS IS A CONFIGURATION ERROR, SINCE THIS DISK SHOULDN'T  WRI08300
*    HAVE BEEN ALLOCATED TO THIS GUY IN R/W MODE IN THE FIRST PLACE.    WRI08310
*    REJECT THIS WRITE REQUEST WITH A RETURN CODE = X'400C' AND         WRI08320
*    GO TO LEAVE TO CLOSE THE FILE.                                     WRI08330
         MVC   RETCODE,=X'0000400C'                                     WRI08340
         B     LEAVE                                                    WRI08350
         SPACE 3                                                        WRI08360
ERROR22  DS    0H                                                       WRI08370
*    I GOT SOME OTHER KIND OF ERROR (NOT ANY OF THE ABOVE) FROM THE     WRI08380
*    FSWRITE MACRO.  REPORT THIS ERROR WITH A RETURN CODE = X'5020'     WRI08390
         MVC   RETCODE,=X'00005020'                                     WRI08400
         B     LEAVE                                                    WRI08410
         EJECT                                                          WRI08420
CPDATA   DS    4D        FOR CP TO PUT THE CURRENT DATE AND TIME        WRI08430
REGSAVE  DS    15F       READ ROUTINE SAVE AREA                         WRI08440
SAVEAREA DS    20F       MY SAVE AREA FOR WHEN I CALL OTHER SUBROUTINES WRI08450
UTSPARMS DS    CL28      SENT TO THE UTS IN THE REPLY CONTROL BLOCK     WRI08460
         ORG   UTSPARMS                                                 WRI08470
STARTRCD DS    F         STARTING RECORD NUMBER IN THE CMS FILE         WRI08480
BYTECNT  DS    F         NUMBER OF BYTES THE UTS WILL SEND              WRI08490
UTSLRECL DS    F         LRECL OF FIXED-LENGTH UTS DATA                 WRI08500
RETCODE  DS    F         RETURN CODE                                    WRI08510
RCDCNTR  DS    F         RECORD COUNTER (# OF RECORDS I'VE WRITTEN)     WRI08520
BIGGEST  DS    F         BIGGEST RECORD SIZE IN INPUT STREAM            WRI08530
NEXTSR#  DS    F         STARTING RECORD NUMBER FOR THE NEXT WRITE      WRI08540
         ORG                                                            WRI08550
TEMPA    DS    D         TEMPORARY WORK AREAS FOR UNPACKING, ETC        WRI08560
TEMPB    DS    D         TEMPORARY WORK AREAS FOR UNPACKING, ETC        WRI08570
OUTBUFR  DS    F         STARTING ADDRESS OF THE OUTPUT BUFFER          WRI08580
NEXTBLOK DS    F         ADDRESS OF NEXT SOURCE FORMAT INPUT BLOCK      WRI08590
EOBUFFER DS    F         ADDRESS OF LAST BYTE IN INPUT BUFFER + 1       WRI08600
VL       DS    PL4                                                      WRI08610
SAVERCNT DS    H         COUNT OF # RECORDS IN THIS SOURCE FORMAT BLOCK WRI08620
PADCHAR  DS    C         PAD CHARACTER IN CASE WE'RE WRITING A FIXED    WRI08630
*                        LENGTH CMS FILE AND THIS INPUT RECORD LENGTH   WRI08640
*                        IS LESS THAN THE CMS FILE'S LRECL              WRI08650
RITFLAGA DC    X'00'        STATUS FLAG FOR WRITE ROUTINE               WRI08660
FIXEDCMS     EQU   X'80'      1 = THE CMS FILE HAS FIXED LENGTH RECORDS WRI08670
*                                 ELSE IT HAS VARIABLE LENGTH RECORDS   WRI08680
FIXEDUTS     EQU   X'40'      1 = THE INPUT DATA IS IN UTS FIXED        WRI08690
*                                 FORMAT ELSE IT'S IN VARIABLE FORMAT   WRI08700
TRUNC        EQU   X'20'      1 = TRUNCATION OF INPUT DATA HAS OCCURRED WRI08710
LASTINC      EQU   X'10'      1 = THE LAST INPUT RECORD WAS INCOMPLETE  WRI08720
NEW          EQU   X'08'      1 = I'M CREATING A NEW FILE               WRI08730
ERROR        EQU   X'04'      1 = I GOT SOME KIND OF ERROR              WRI08740
SFORMAT      EQU   X'02'      1 = THIS INPUT IS IN UTS SOURCE FORMAT    WRI08750
*                                                                       WRI08760
RITFLAGB DC    X'00'        ANOTHER FLAG FOR THE WRITE ROUTINE          WRI08770
CREATE       EQU   X'80'      1 = THIS IS A CREATE WRITE                WRI08780
REPLACE      EQU   X'40'      1 = THIS A WRITE AND REPLACE              WRI08790
INCRVL       EQU   X'20'      1 = THIS IS A WRITE AND INCREMENT THE     WRI08800
*                                 VERSION LEVEL                         WRI08810
APPEND       EQU   X'10'      1 = THIS IS A WRITE AND APPEND            WRI08820
DA           EQU   X'08'      1 = THIS IS A DIRECT ACCESS WRITE         WRI08830
MYFSCB   FSCB                                                           WRI08840
         FSCBD                                                          WRI08850
WRITE    CSECT            GO BACK TO NORMAL CSECT                       WRI08860
         LTORG                                                          WRI08870
*                                                                       WRI08880
         FSTD                                                           WRI08890
WRITE    CSECT            GO BACK TO NORMAL CSECT                       WRI08900
         ICDATA                                                         WRI08910
         END                                                            WRI08920