- AIBCVT3 ;IHS/DDPS/DFM-IBM STAT RECORDS WRITE [ 01/12/89 1:11 PM ]
- ;1.3; 1/13/89 DEFAULT TO "3" ON RG3 SOURCE - PIECE 7 INSTEAD OF "2"
- ;1.3 RECODE BUILD OF DELETE MERGE NODE TO SET SOURCE = 3
- ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
- ;1.0; 3/28/88
- G:AIBFILE="ibmjob" BLDCARDS D WRITE U AIBPDV G RETURN
- BLDCARDS ;BUILD CARDS FOR RJE BYSYNC JOB SUBMISSION
- S AIBB1=1,AIBOW=AIBOT_AIBOT(1),(AIBOT,AIBOT(1))=""
- CARDLOOP ;BUILD NEXT CARD
- S AIBRK=$P(AIBB(AIBB1),U,1),AIBRKB=$P(AIBB(AIBB1),U,6)
- S AIBRL=$P(AIBB(AIBB1),U,4),AIBRB=$P(AIBB(AIBB1),U,5)
- S AIBRE=AIBRB+AIBRL-1
- I AIBRKB<2 G MOVREST
- S AIBOT=$E(AIBOW,AIBRB,AIBRE)_$J("",80-AIBRL-$L(AIBRK))_AIBRK G WRITEC
- MOVREST ;
- S:AIBRKB=0 AIBRK=""
- S AIBOT=AIBRK_$E(AIBOW,AIBRB,AIBRE)_$J("",80-AIBRL-$L(AIBRK))
- WRITEC ;WRITE 1 CARD
- D WRITE I AIBB1=AIBB2 U AIBPDV G RETURN
- S AIBB1=AIBB1+1,AIBOT="" G CARDLOOP
- WRITE ;WRITE RECORD TO FILE
- U AIBTDV W AIBOT,AIBOT(1) S (AIBOT,AIBOT(1))=""
- I AIBOS="D" G DSMLOGIC
- W ! G:$L(AIBJ)>0 RETURN G DISPLAY
- DSMLOGIC ;SPECIAL WRITE LOGIC FOR DSM
- X ^%ZOSF("MTERR") I Y S AIBA="R" G RETURN
- X ^%ZOSF("EOT") I Y D NEWTAPE G:$L(AIBA)>0 RETURN
- DISPLAY ;DISPLAY RECORD COUNT ON CONSOLE (BY 10S)
- S AIBCTW=AIBCTW+1 U AIBCDV S AIBRM=AIBCTW#10 G:AIBRM>0 RETURN
- S AIBLK="",AIBLK=AIBLK_$J("",8-$L(AIBCTW)) W AIBLK,AIBCTW G RETURN
- NEWTAPE ;WRITE TAPEMARK, CLOSE AND REWIND, MOUNT AND OPEN NEXT TAPE
- U AIBTDV W %MT("WTM"),%MT("REW") S IO=AIBTDV X ^%ZIS("C")
- S AIBMSG="Tape # "_AIBTC_" Volume Serial Number Created : "_AIBV
- D ERRMSG^AIBCVT6 D MOUNT^AIBSDEV1 G RETURN
- WRITET ;WRITE TEMPORY GLOBAL FOR DIFFERENT FORMAT RECORDS
- I $L(AIBTZ)>0 G CKNEXT
- S AIBTZ=0,AIBZ(0)=AIBZ,AIBZZ(0)=AIBZZ,AIBZ=0,AIBZZ=0
- S @AIBTGLT=@AIBGBLT,AIBZ=AIBZ(0),@AIBTGFT=@AIBGBFT,AIBZZ=AIBZZ(0)
- CKNEXT ;
- I AIBZ=AIBZ(0) G NEXT
- S AIBZ(1)=AIBZ,AIBZ=AIBZ(0),AIBZZ(0)=AIBZZ,AIBZZ=0
- S AIBTZ(0)=AIBTZ,AIBTZ=0
- S $P(@AIBTGFT,U,3)=AIBTZ(0),$P(@AIBTGFT,U,4)=AIBTZ(0)
- S AIBTZ(1)=AIBTZ(1)+AIBTZ(0),AIBZ=AIBZ(1),AIBZ(0)=AIBZ
- S @AIBTGFT=@AIBGBFT,AIBZZ=AIBZZ(0)
- NEXT ;PROCESS CONTINUE
- S AIBTZ=AIBTZ+1 G:AIBNK="RG3" RG3FORM
- I AIBNK="RG4" G RG4BATH
- S AIBOT=AIBIN G CONTWT
- RG3FORM ;REFORMAT NODE RG3 REGISTRATION DELETE MERGE
- S AIBRG4=$P(AIBIN,U,4) IF $L(AIBRG4)=0 S AIBRRR="" G RG3BLD
- S AIBRRR="RRR"
- RG3BLD ;BUILD NEW RG3 NODE
- S AIBRG2=$P(AIBIN,U,2),AIBSRC=$P(AIBIN,U,7) S:AIBSRC="" AIBSRC="3"
- S AIBOT="RG3"_U_$E(AIBRG2,1,2)_$E(AIBRG2,1,6)_$E(AIBRG2,1,6)_U_"?"
- S AIBOT=AIBOT_U_$P(AIBIN,U,5)_U_$P(AIBIN,U,6)_U_AIBRRR_U_$P(AIBIN,U,3)
- S AIBOT=AIBOT_U_"99RR"_U_AIBYMD_U_"***"_U_AIBRRR_U_AIBRG4_U_AIBSRC K AIBSRC
- S AIBOT=AIBOT_U_$E(AIBRG2,5,6) G CONTWT
- RG4BATH ;EXPAND BATCH HEADER CONTROL DATA FOR RG4 RECORDS
- S AIBOT=AIBIN G:AIBGBLP="AGTX" CONTWT
- S AIBRG2=$P(AIBOT,U,2)
- S $P(AIBOT,U,2)=$E(AIBRG2,1,2)_$E(AIBRG2,1,6)_$E(AIBRG2,1,6)
- G CONTWT
- CONTWT ;READY FOR WRITE OF TEMP NODE
- S @AIBTGFT=AIBOT,AIBOT="",AIBCT2=AIBCT2+1
- RETURN ;RETURN TO CALLING ROUTINE
- Q
- AIBCVT3 ;IHS/DDPS/DFM-IBM STAT RECORDS WRITE [ 01/12/89 1:11 PM ]
- +1 ;1.3; 1/13/89 DEFAULT TO "3" ON RG3 SOURCE - PIECE 7 INSTEAD OF "2"
- +2 ;1.3 RECODE BUILD OF DELETE MERGE NODE TO SET SOURCE = 3
- +3 ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
- +4 ;1.0; 3/28/88
- +5 IF AIBFILE="ibmjob"
- GOTO BLDCARDS
- DO WRITE
- USE AIBPDV
- GOTO RETURN
- BLDCARDS ;BUILD CARDS FOR RJE BYSYNC JOB SUBMISSION
- +1 SET AIBB1=1
- SET AIBOW=AIBOT_AIBOT(1)
- SET (AIBOT,AIBOT(1))=""
- CARDLOOP ;BUILD NEXT CARD
- +1 SET AIBRK=$PIECE(AIBB(AIBB1),U,1)
- SET AIBRKB=$PIECE(AIBB(AIBB1),U,6)
- +2 SET AIBRL=$PIECE(AIBB(AIBB1),U,4)
- SET AIBRB=$PIECE(AIBB(AIBB1),U,5)
- +3 SET AIBRE=AIBRB+AIBRL-1
- +4 IF AIBRKB<2
- GOTO MOVREST
- +5 SET AIBOT=$EXTRACT(AIBOW,AIBRB,AIBRE)_$JUSTIFY("",80-AIBRL-$LENGTH(AIBRK))_AIBRK
- GOTO WRITEC
- MOVREST ;
- +1 IF AIBRKB=0
- SET AIBRK=""
- +2 SET AIBOT=AIBRK_$EXTRACT(AIBOW,AIBRB,AIBRE)_$JUSTIFY("",80-AIBRL-$LENGTH(AIBRK))
- WRITEC ;WRITE 1 CARD
- +1 DO WRITE
- IF AIBB1=AIBB2
- USE AIBPDV
- GOTO RETURN
- +2 SET AIBB1=AIBB1+1
- SET AIBOT=""
- GOTO CARDLOOP
- WRITE ;WRITE RECORD TO FILE
- +1 USE AIBTDV
- WRITE AIBOT,AIBOT(1)
- SET (AIBOT,AIBOT(1))=""
- +2 IF AIBOS="D"
- GOTO DSMLOGIC
- +3 WRITE !
- IF $LENGTH(AIBJ)>0
- GOTO RETURN
- GOTO DISPLAY
- DSMLOGIC ;SPECIAL WRITE LOGIC FOR DSM
- +1 XECUTE ^%ZOSF("MTERR")
- IF Y
- SET AIBA="R"
- GOTO RETURN
- +2 XECUTE ^%ZOSF("EOT")
- IF Y
- DO NEWTAPE
- IF $LENGTH(AIBA)>0
- GOTO RETURN
- DISPLAY ;DISPLAY RECORD COUNT ON CONSOLE (BY 10S)
- +1 SET AIBCTW=AIBCTW+1
- USE AIBCDV
- SET AIBRM=AIBCTW#10
- IF AIBRM>0
- GOTO RETURN
- +2 SET AIBLK=""
- SET AIBLK=AIBLK_$JUSTIFY("",8-$LENGTH(AIBCTW))
- WRITE AIBLK,AIBCTW
- GOTO RETURN
- NEWTAPE ;WRITE TAPEMARK, CLOSE AND REWIND, MOUNT AND OPEN NEXT TAPE
- +1 USE AIBTDV
- WRITE %MT("WTM"),%MT("REW")
- SET IO=AIBTDV
- XECUTE ^%ZIS("C")
- +2 SET AIBMSG="Tape # "_AIBTC_" Volume Serial Number Created : "_AIBV
- +3 DO ERRMSG^AIBCVT6
- DO MOUNT^AIBSDEV1
- GOTO RETURN
- WRITET ;WRITE TEMPORY GLOBAL FOR DIFFERENT FORMAT RECORDS
- +1 IF $LENGTH(AIBTZ)>0
- GOTO CKNEXT
- +2 SET AIBTZ=0
- SET AIBZ(0)=AIBZ
- SET AIBZZ(0)=AIBZZ
- SET AIBZ=0
- SET AIBZZ=0
- +3 SET @AIBTGLT=@AIBGBLT
- SET AIBZ=AIBZ(0)
- SET @AIBTGFT=@AIBGBFT
- SET AIBZZ=AIBZZ(0)
- CKNEXT ;
- +1 IF AIBZ=AIBZ(0)
- GOTO NEXT
- +2 SET AIBZ(1)=AIBZ
- SET AIBZ=AIBZ(0)
- SET AIBZZ(0)=AIBZZ
- SET AIBZZ=0
- +3 SET AIBTZ(0)=AIBTZ
- SET AIBTZ=0
- +4 SET $PIECE(@AIBTGFT,U,3)=AIBTZ(0)
- SET $PIECE(@AIBTGFT,U,4)=AIBTZ(0)
- +5 SET AIBTZ(1)=AIBTZ(1)+AIBTZ(0)
- SET AIBZ=AIBZ(1)
- SET AIBZ(0)=AIBZ
- +6 SET @AIBTGFT=@AIBGBFT
- SET AIBZZ=AIBZZ(0)
- NEXT ;PROCESS CONTINUE
- +1 SET AIBTZ=AIBTZ+1
- IF AIBNK="RG3"
- GOTO RG3FORM
- +2 IF AIBNK="RG4"
- GOTO RG4BATH
- +3 SET AIBOT=AIBIN
- GOTO CONTWT
- RG3FORM ;REFORMAT NODE RG3 REGISTRATION DELETE MERGE
- +1 SET AIBRG4=$PIECE(AIBIN,U,4)
- IF $LENGTH(AIBRG4)=0
- SET AIBRRR=""
- GOTO RG3BLD
- +2 SET AIBRRR="RRR"
- RG3BLD ;BUILD NEW RG3 NODE
- +1 SET AIBRG2=$PIECE(AIBIN,U,2)
- SET AIBSRC=$PIECE(AIBIN,U,7)
- IF AIBSRC=""
- SET AIBSRC="3"
- +2 SET AIBOT="RG3"_U_$EXTRACT(AIBRG2,1,2)_$EXTRACT(AIBRG2,1,6)_$EXTRACT(AIBRG2,1,6)_U_"?"
- +3 SET AIBOT=AIBOT_U_$PIECE(AIBIN,U,5)_U_$PIECE(AIBIN,U,6)_U_AIBRRR_U_$PIECE(AIBIN,U,3)
- +4 SET AIBOT=AIBOT_U_"99RR"_U_AIBYMD_U_"***"_U_AIBRRR_U_AIBRG4_U_AIBSRC
- KILL AIBSRC
- +5 SET AIBOT=AIBOT_U_$EXTRACT(AIBRG2,5,6)
- GOTO CONTWT
- RG4BATH ;EXPAND BATCH HEADER CONTROL DATA FOR RG4 RECORDS
- +1 SET AIBOT=AIBIN
- IF AIBGBLP="AGTX"
- GOTO CONTWT
- +2 SET AIBRG2=$PIECE(AIBOT,U,2)
- +3 SET $PIECE(AIBOT,U,2)=$EXTRACT(AIBRG2,1,2)_$EXTRACT(AIBRG2,1,6)_$EXTRACT(AIBRG2,1,6)
- +4 GOTO CONTWT
- CONTWT ;READY FOR WRITE OF TEMP NODE
- +1 SET @AIBTGFT=AIBOT
- SET AIBOT=""
- SET AIBCT2=AIBCT2+1
- RETURN ;RETURN TO CALLING ROUTINE
- +1 QUIT
