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
