Thanks again for everyone's help. If anyone cares, here is the assembler program that reads the spanned file and creates a fixed length 136 byte file padded with blanks where necessary. I don't claim to be the best assembler programmer. I hope that worked in my favor in keeping it simple. But I am definitely up for constructive criticism.
I am including the JCL and 2 more programs (a cobol and a rexx). This is the reason I took so long to get back with this. Sorry if this is too much information. ======================================================================================= TITLE 'XP1000' * * 02/25/11 B HUNT CHANGED A SPANNED FILE TO A FIXED FILE * XP1000 AMODE 24 XP1000 RMODE 24 XP1000 START COPY EQUATES SAVE (14,12) SAVE REGISTERS 14 THRU 12 BASR BASE1,0 ESTABLISH ADDRESSABILITY USING *,BASE1 PROVIDE BASE ID ST RD,SAVEAREA+4 STORE PREV REG 13 IN SAVEAREA +4 LA RD,SAVEAREA LOAD SAVEREA IN REG 13 B BEGIN SPACE 1 DS 0D DC CL8'XP1000' DC CL8'&SYSDATE' DC CL8'&SYSTIME' SPACE 1 BEGIN DS 0H USING DATA,R8 ASSOCIATE DATA WITH REG 8 OPEN (INFILE,(INPUT),OUTFILE,(OUTPUT)) OPEN FILES LTR RF,RF CHECK FOR GOOD OPEN BNZ BADOPEN IF BAD OPEN BRANCH TO BADOPEN LOOP DS 0H PROCESS LOOP GET INFILE READ INPUT FILE LR R8,R1 LOAD INPUT ADDRESS IN REG 8 XC FWLEN,FWLEN SET FULL WORD LENGTH TO ZERO MVC HWLEN,DATA GET THE RECORD LENGTH FROM DATA MVI FWLEN,C' ' USE A BLANK TO PAD OUTREC-MVCL L R9,FWLEN LOAD THE INPUT LENGTH IN REG 9 LA R6,BATA LOAD THE OUTPUT ADDRESS IN REG 6 LA R7,136 LOAD THE OUT LENGTH IN REG 7 MVCL R6,R8 MOVE DATA TO BATA W/ BLANK PAD WRITE DS 0H PUT OUTFILE,OUTREC WRITE OUTREC B LOOP FINAL DS 0H CLOSE (INFILE,,OUTFILE) B C100 BADOPEN WTO ' UABLE TO OPEN FILE',ROUTCDE=(2),DESC=(7) B C100 BADREAD WTO ' READ UNSUCCESSFUL ',ROUTCDE=(2),DESC=(7) B C100 BADSEG WTO ' SEGMENTS NOT SEQUENTIAL ',ROUTCDE=(2),DESC=(7) B C100 BADWRITE WTO ' WRITE UNSUCCESSFUL ',ROUTCDE=(2),DESC=(7) B C100 C100 DS 0H L RD,SAVEAREA+4 RETURN (14,12) RESTORE REGISTERS AND RETURN INFILE DCB DSORG=PS,RECFM=VBS,MACRF=GL, + DDNAME=INDD,EODAD=FINAL OUTFILE DCB DSORG=PS,RECFM=FB,LRECL=136,MACRF=PM, + DDNAME=OUTDD OUTREC DS 0CL136 BATA DS CL136 SAVEAREA DS 18F FWLEN DS 0F DS H HWLEN DS H LTORG INREC DSECT DATA DS CL136 DS CL32000 DS CL32000 DS CL32000 END XP1000 ================================================================================================ //FIXSPAND JOB (DP,6010),'XXXXXX - XXXX ',CLASS=A,MSGCLASS=X, // MSGLEVEL=(1,1),NOTIFY=&SYSUID //* //RMS EXEC CA11RMS,TYPRUN='F' //* //* CHANGED SPANNED RECORDS TO FIXED //ASMEXEC EXEC PGM=XP1000,REGION=0M //STEPLIB DD DISP=SHR,DSN=TEST.LOADLIB //INDD DD DISP=SHR,DSN=TEST.BACKUP //OUTDD DD DSN=TEST.BACKUP.FIXED, // DISP=(,CATLG,CATLG), // SPACE=(TRK,(1950,100),RLSE), // DCB=(LRECL=136,BLKSIZE=0,RECFM=FB) //SYSOUT DD SYSOUT=* //SYSDBOUT DD SYSOUT=* //SYSUDUMP DD SYSOUT=* //* //* PUT MULTI SEGMENTS BACK TOGETHER AS 1 RECORD //COBEXEC EXEC BATCOB,PROG=XP1001,ENV=DEVL,REGION=0M //STEPLIB DD DISP=SHR,DSN=TEST.LOADLIB //FONTIN DD DISP=SHR,DSN=TEST.BACKUP.FIXED //FONTOUT DD DSN=TEST.BACKUP.JOINED, // DISP=(,CATLG,CATLG), // SPACE=(TRK,(1950,100),RLSE), // DCB=(LRECL=136,BLKSIZE=0,RECFM=FB) //SYSOUT DD SYSOUT=* //SYSDBOUT DD SYSOUT=* //SYSUDUMP DD SYSOUT=* //* //* READ HEADER RECORD AND GET FONT NAME & DISCARD RECORD //* (IF THE NAME BEGINS WITH A NUMBER ADD AN 'F' ON FRONT) //* READ DATA RECORDS AND SAVE IN A TABLE //* READ TRAILER RECORD & DISCARD, WRITE FONT DATA TO PDS MEMBER //* MAKE SURE THE HEADER AND TRAILER MATCH //* REPEAT FOR NEXT FONT //REXXBAT1 EXEC PGM=IKJEFT01,DYNAMNBR=90, // PARM=('FONTPDS') //SYSPROC DD DSN=TEST.EXEC,DISP=SHR //FONTIN DD DISP=SHR,DSN=TEST.BACKUP.JOINED //SYSTSPRT DD SYSOUT=* //SYSTSIN DD DUMMY //SYSPRINT DD SYSOUT=* //SYSABEND DD SYSOUT=* //SYSUDUMP DD SYSOUT=* //SYSOUT DD SYSOUT=* // ========================================================================= IDENTIFICATION DIVISION. PROGRAM-ID. XP1001. AUTHOR. BRUCE HUNT. INSTALLATION. XXXXXXX XXXXXXXXX. DATE-WRITTEN. MAR 11, 2011. DATE-COMPILED. *REMARKS. ************************************************* * * THIS PROGRAM READS SPLIT RECORDS AND WRITES * * * THEM AS A ONE RECORD. * * * * * ************************************************* ENVIRONMENT DIVISION. CONFIGURATION SECTION. OBJECT-COMPUTER. Z2098. SOURCE-COMPUTER. Z2098. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT FONT-SPLIT-FILE ASSIGN TO FONTIN. SELECT FONT-FILE ASSIGN TO FONTOUT. DATA DIVISION. FILE SECTION. FD FONT-SPLIT-FILE LABEL RECORDS ARE OMITTED BLOCK CONTAINS 0. 01 FONT-SPLIT-RCD. 05 FONT-SP-LGTH PIC 9(04) USAGE BINARY. 05 FONT-SP-SEGNUM PIC 9(01). 05 FILLER PIC X(01). 05 FONT-SP-TYPE PIC 9(04). 05 FONT-SP-NAME PIC X(08). 05 FONT-SP-TRLR-END PIC X(12). 05 FONT-SP-HEDR-END PIC X(48). 05 FONT-SP-DATA-END PIC X(60). FD FONT-FILE LABEL RECORDS ARE OMITTED BLOCK CONTAINS 0. 01 FONT-RECORD. 05 FONT-LGTH PIC 9(04) USAGE BINARY. 05 FONT-SEGNUM PIC X(01). 05 FILLER PIC X(01). 05 FONT-TYPE PIC 9(04). 05 FONT-NAME PIC X(08). 05 FONT-TRLR-END PIC X(12). 05 FONT-HEDR-END PIC X(48). 05 FONT-DATA-END PIC X(60). WORKING-STORAGE SECTION. *================================================================* * RECORD SEGMENT FLAG USES 88 LEVELS TO REFER TO HEX VALUE * * SEGMENT NUMBERS: * * 1) BASE-ONLY-HEX00 HAS A HEX VALUE OF X'00' DISPLAYS AS ' ' * * 2) BASE-SEGMENT-HEX01 HAS A HEX VALUE OF X'01' DISPLAYS AS ' ' * * 3) BASE-SEGMENT-HEX02 HAS A HEX VALUE OF X'02' DISPLAYS AS ' ' * *================================================================* 01 FLAGS-STATUSES-DISPLAYS. 05 END-OF-FILE-FLAG PIC X. 88 NO-MORE-RECORDS VALUE 'Y'. 05 RCD-SEGMENT-FLAG PIC X. 88 BASE-ONLY-HEX00 VALUE ' '. 88 1ST-SEGMENT-HEX01 VALUE ' '. 88 2ND-SEGMENT-HEX02 VALUE ' '. 01 ZERO-OUT PIC 9(4) USAGE BINARY VALUE 0. 01 ONE PIC 9(4) USAGE BINARY VALUE 1. 01 FOUR PIC 9(4) USAGE BINARY VALUE 4. 01 STARTPOS PIC 9(4) USAGE BINARY VALUE 0. 01 NEWLGTH PIC 9(4) USAGE BINARY VALUE 0. 01 IN-COUNT PIC 9(5) USAGE COMP-3 VALUE 0. 01 OUT-SEG00 PIC 9(5) USAGE COMP-3 VALUE 0. 01 OUT-SEG01 PIC 9(5) USAGE COMP-3 VALUE 0. 01 OUT-SEG02 PIC 9(5) USAGE COMP-3 VALUE 0. 01 OUT-OTHER PIC 9(5) USAGE COMP-3 VALUE 0. 01 OUT-RECORDS PIC 9(5) USAGE COMP-3 VALUE 0. PROCEDURE DIVISION. MAIN-PROCESS. OPEN INPUT FONT-SPLIT-FILE. OPEN OUTPUT FONT-FILE. MOVE 'N' TO END-OF-FILE-FLAG. MOVE 0 TO IN-COUNT. MOVE 0 TO OUT-SEG00. MOVE 0 TO OUT-SEG01. MOVE 0 TO OUT-SEG02. MOVE 0 TO OUT-OTHER. MOVE 0 TO OUT-RECORDS. READ FONT-SPLIT-FILE AT END MOVE 'Y' TO END-OF-FILE-FLAG. PERFORM 1000-BUILD-OUTPUT UNTIL NO-MORE-RECORDS. DISPLAY 'RECORDS IN: ' IN-COUNT. DISPLAY '00 SEGMENTS OUT: ' OUT-SEG00. DISPLAY '01 SEGMENTS OUT: ' OUT-SEG01. DISPLAY '02 SEGMENTS OUT: ' OUT-SEG02. DISPLAY 'OTHER SEGMENTS OUT: ' OUT-OTHER. DISPLAY 'TOTAL RECORDS OUT: ' OUT-RECORDS. CLOSE FONT-FILE. CLOSE FONT-SPLIT-FILE. STOP RUN. 1000-BUILD-OUTPUT. *================================================================* * BUILD OUTPUT PROCESS * * 1) ADD 1 TO THE IN RECORD COUNT * * 2) MOVE THE INPUT SEGMENT NUMBER RECORD SEGMENT FLAG SO 88 * * LEVELS CAN BE USED TO DISTINGUISH BETWEEN INPUT SEGMENT * * NUMBERS OF HEX '00', '01', AND '02'. * * 3) IF THIS RECORD HAS ONLY 1 SEGMENT ASSOCIATED WITH IT (A * * BASE ONLY X'00' RECORD)' * * A) ADD 1 TO THE SEGMENT 00 OUT RECORD COUNT AND THE OUT * * RECORDS COUNT * * B) WRITE THE RECORD AS IS TO THE OUTPUT FILE * * 4) IF THIS RECORD HAS MULTIPLE RECORD SEGMENTS AND THIS IS THE * * THE 1ST SEGMENT (AN X'01' RECORD) * * A) ADD 1 TO THE SEGMENT 01 OUT RECORD COUNT * * B) MOVE THIS 1ST SEGMENT TO BEGINNING OF THE OUTPUT RECORD * * C) DETERMINE THE STARTING POSITION ON THE OUTPUT RECORD TO * * MOVE THE NEXT SEGMENT TO * * 5) IF THIS RECORD IS THE 2ND SEGMENT (AN X'02' RECORD) OF * * MULTIPLE SEGMENT RECORDS * * A) ADD 1 TO THE SEGMENT 02 OUT RECORD COUNT AND THE OUT * * RECORDS COUNT * * B) SUBTRACT 4 BYTES FROM THE SEGMENT LENGTH BECAUSE WE HAVE * * LENGTH AND RECORD TYPE IN OUR OUTPUT RECORD ALREADY FROM * * THE X'01' SEGMENT AND WON'T MOVE THE 1ST 4 BYTES OF THE * * X'02 SEGMENT * * C) MOVE THE X'02' SEGMENT MINUS THE 1ST 4 BYTES TO THE * * OUTPUT RECORD RIGHT AFTER THE X'01' SEGMENT * * D) MOVE X'00' TO THE OUTPUT RECORDS'S SEGMENT NUMBER SINCE * * THIS IS NO LONGER A MULTIPLE SEGMENT RECORD * * E) CALCULATE THE NEW LENGTH OF THE COMBINED SEGMENTS RECORD * * E) MOVE THE NEW LENGTH TO THE LENGTH FIELD OF THE OUTPUT * * RECORD * * B) WRITE COMBINED SEGMENTS RECORD TO THE OUTPUT FILE * * 6) IF THIS RECORD IS A SEGMENT NUMBER GREATER THAN X'02' FLAG * * IT FOR NOW AND SET THE CONDITION CODE TO 9999 FOR THIS JOB * * STEP. IN OUR APPLICATION WE ONLY HAVE X'01', X'02', AND * * X'03' SEGMENTS * *================================================================* ADD 1 TO IN-COUNT. MOVE FONT-SP-SEGNUM TO RCD-SEGMENT-FLAG. IF BASE-ONLY-HEX00 ADD 1 TO OUT-SEG00 ADD 1 TO OUT-RECORDS WRITE FONT-RECORD FROM FONT-SPLIT-RCD ELSE IF 1ST-SEGMENT-HEX01 ADD 1 TO OUT-SEG01 MOVE FONT-SPLIT-RCD(1:FONT-SP-LGTH) TO FONT-RECORD(1:FONT-SP-LGTH) MOVE FONT-SP-LGTH TO STARTPOS ADD ONE TO STARTPOS ELSE IF 2ND-SEGMENT-HEX02 ADD 1 TO OUT-SEG02 ADD 1 TO OUT-RECORDS SUBTRACT FOUR FROM FONT-SP-LGTH MOVE FONT-SPLIT-RCD(5:FONT-SP-LGTH) TO FONT-RECORD (STARTPOS:FONT-SP-LGTH) MOVE ' ' TO FONT-SEGNUM MOVE STARTPOS TO NEWLGTH SUBTRACT ONE FROM NEWLGTH ADD FONT-SP-LGTH TO NEWLGTH MOVE ZERO-OUT TO FONT-LGTH ADD NEWLGTH TO FONT-LGTH WRITE FONT-RECORD ELSE ADD 1 TO OUT-OTHER MOVE 9999 TO RETURN-CODE DISPLAY FONT-SPLIT-RCD DISPLAY 'THIS SEGMENT IS NOT VALID AT THIS TIME!!!!'. READ FONT-SPLIT-FILE AT END MOVE 'Y' TO END-OF-FILE-FLAG. ====================================================================================== /*REXX EXEC - FONTPDS - SEE JCL FOR COMMENTS */ PARSE ARG OUTFILE FILELGTH OUTFILE="TEST.BKUP.FONTS" /* DO WHILE OUTFILE="" */ /* SAY "PLEASE ENTER THE NAME OF THE OUTPUT FILE (CANNOT = SPACES)." */ /* SAY "EXAMPLE: TEST.BKUP.FONTS - (enter END to exit)." */ /* PARSE PULL OUTFILE */ /* IF OUTFILE = "END" THEN */ /* EXIT */ /* IF OUTFILE = "end" THEN */ /* EXIT */ /* END */ "EXECIO 1 DISKR FONTIN" READRC = RC FDX = 0 RCDCNT = 0 DO WHILE READRC = 0 PARSE PULL FONTREC RECTYPE = SUBSTR(FONTREC,5,4) IF RECTYPE = 'DATA' THEN DO FDX = FDX + 1 FONTMEM.FDX = SUBSTR(FONTREC,9,128) END ELSE IF RECTYPE = 'HEDR' THEN DO MEM = SPACE(SUBSTR(FONTREC,9,8)) MEM1 = SUBSTR(MEM,1,1) IF MEM1 == 0 THEN MEM = 'F' || MEM IF MEM1 == 1 THEN MEM = 'F' || MEM IF MEM1 == 2 THEN MEM = 'F' || MEM IF MEM1 == 3 THEN MEM = 'F' || MEM IF MEM1 == 4 THEN MEM = 'F' || MEM IF MEM1 == 5 THEN MEM = 'F' || MEM IF MEM1 == 6 THEN MEM = 'F' || MEM IF MEM1 == 7 THEN MEM = 'F' || MEM IF MEM1 == 8 THEN MEM = 'F' || MEM IF MEM1 == 9 THEN MEM = 'F' || MEM FDX = 0 DROP FONTMEM. END ELSE IF RECTYPE = 'TRLR' THEN DO TRAILER = SPACE(SUBSTR(FONTREC,9,8)) TRAILER1 = SUBSTR(TRAILER,1,1) IF TRAILER1 == 0 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 1 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 2 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 3 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 4 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 5 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 6 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 7 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 8 THEN TRAILER = 'F' || TRAILER IF TRAILER1 == 9 THEN TRAILER = 'F' || TRAILER IF MEM ¬= TRAILER THEN SAY "HEDR:" MEM "DOES NOT MATCH THE TRAILER" TRAILER "!!!" ELSE CALL SAVEFONT END "EXECIO 1 DISKR FONTIN" READRC = RC END "EXECIO 0 DISKR FONTIN (FINIS" "FREE DD("FONTIN")" EXIT SAVEFONT: FONTMEM.0 = FDX FONT_OUT = "'" || OUTFILE || "(" || MEM || ")'" "FREE DD("FONTOUT")" "ALLOC DA("FONT_OUT") FILE(" FONTOUT ") REUSE" "EXECIO * DISKW FONTOUT (FINIS STEM FONTMEM." RETURN ---------------------------------------------------------------------- For IBM-MAIN subscribe / signoff / archive access instructions, send email to lists...@bama.ua.edu with the message: GET IBM-MAIN INFO Search the archives at http://bama.ua.edu/archives/ibm-main.html