AIBMRG1 ;RPMS/CMB/TJF ;GENERIC GLOBAL MERGE MULTIPLE REEL ROUTINE [ 02/01/89 9:13 AM ]
;1.3 ;MODIFY TO KILL LOCAL VARIABLES OVERLOOKED IN VER 1.30
;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
;1.1 ;5/30/88
INIT ;INITIALIZE FIELDS
S AIBPCC=0 S:'$D(U) U="^"
K X,AIBGBL,AIBFD S AIBSEQ=1,(AIBA,AIBMSG)=""
S (IO(0),AIBCDV)=$I I ^%ZOSF("OS")["MSM" S AIBOS="M"
E S AIBOS="D"
K AIBFBD,AIBFED,AIBS,AIBFTR
D IN^AIBSDEV
G RETURN
NEXTFILE ;
U AIBCDV W !,"Sequence #",AIBSEQ," restored",!
U AIBDEV R AIBXX:DTIME G:'$T SEQNO U AIBCDV I AIBXX="**" S QUIT=1 G RETURN
SEQNO U AIBCDV W !,"Please put sequence #",AIBSEQ+1," into the drive and"
S AIBSEQ=AIBSEQ+1
NEXTFIL1 R !,"Press <RETURN> when ready",AIBXX:DTIME G:'$T NEXTFIL1
I AIBXX?1"?".E W !!,"Press <RETURN> to continue restoring from sequence #",AIBSEQ,!,"or abort the restore by entering 'control C'" G NEXTFIL1
D CLOSE^AIBSDEV S IN=1,AIBPARMS=AIBPSV D OPEN^AIBSDEV
U AIBDEV I '$ZA R AIBXX:DTIME G:'$T NXTSEQ
I $ZC U AIBCDV
E W !!,"Cannot access ",AIBFN,", please correct" G NEXTFIL1
I AIBXX?2NP1":"2N1" ".E S AIBXX=1
I AIBXX'=AIBSEQ W !!,"Out of sequence, this file is #",AIBXX,", please correct" G NEXTFIL1
S QUIT=0 G RETURN
NXTSEQ ;RETRY ACCESS OF FILE
U AIBCDV W !!,"Cannot access ",AIBFN,", please correct"
G NEXTFIL1
FACTSET ;SETUP FACILITY TAPE HEADER VALUES
U AIBCDV W AIBGSEL,!
S AIBGBLP=$E(AIBGSEL,2,5),AIBGBL=U_AIBGBLP_"GLOB"
S AIBGBLN=AIBGBL_"(0)"
S AIBGBLF=AIBGBL_"(AIBFTL,0)"
S AIBGBLD=AIBGBL_"(AIBFTL,AIBCT)"
I AIBPCC G PCCFACL
S AIBFD=AIBGV G GETFCDAT
PCCFACL ;FIND FACILITY LOCATION FOR PCC
S AIBW=$E(AIBGV,21,26),(AIBX,AIBY)="",AIBX=$O(^AUTTLOC("C",AIBW,AIBX))
I AIBX="" G BLDPCC
S AIBY=$P(^AUTTLOC(AIBX,0),U,2)
BLDPCC ;BUILD PCC FACILITY ZEROTH NODE DATA
S AIBFD=AIBW_U_AIBY_U_U_U_U_U
GETFCDAT ;GET FACILITY DATA FROM INPUT FILE
S AIBFTL=$P(AIBFD,"^",1)
S AIBFTN=$P(AIBFD,"^",2)
S AIBFRD=$P(AIBFD,"^",3)
S AIBFTB=$P(AIBFD,"^",4)
S AIBFTE=$P(AIBFD,"^",5)
S AIBFTT=$P(AIBFD,"^",6)
S AIBFCT=$P(AIBFD,"^",7)
S AIBFTC=$P(AIBFD,"^",8)
S AIBFTD=$P(AIBFD,"^",9)
G RETURN
ZERSET ;
S AIBZB=$P(@AIBGBLN,"^",1)
S AIBZE=$P(@AIBGBLN,"^",2)
S AIBZN=$P(@AIBGBLN,"^",3)
S AIBZR=$P(@AIBGBLN,"^",4)
S AIBZF=$P(@AIBGBLN,"^",5)
I $D(@AIBGBLF) G CKMLOG
S $P(@AIBGBLF,"^",1)=$P(AIBFD,"^",4)
S $P(@AIBGBLF,"^",2)=$P(AIBFD,"^",2)
S $P(@AIBGBLF,"^",3)=0
S $P(@AIBGBLF,"^",4)=0
S $P(@AIBGBLF,"^",5)=$P(AIBFD,"^",2)
CKMLOG ;CHECK MERGE LOG FILE
;D SEARCHM^AIBLOGF
G RETURN
FACSET ;
S AIBFBD=$P(@AIBGBLF,"^",1)
S AIBFED=$P(@AIBGBLF,"^",2)
S AIBFTR=$P(@AIBGBLF,"^",3)
S AIBS=$P(@AIBGBLF,"^",4)
S AIBFNM=$P(@AIBGBLF,"^",5)
G RETURN
UPDATE ;BALANCE CHECK
D:$D(AIBDEV) CLOSE^AIBSDEV
I AIBFCT=AIBRC!(AIBPCC) G COMPUTE
U AIBCDV W !!,"# Records Merged and Tape Count Not Equal"
W !,"Tape count was ",AIBFCT
COMPUTE ;UPDATE ZEROTH NODES IN MERGE GLOBAL
I AIBFTB<AIBZB S $P(@AIBGBLN,"^",1)=AIBFTB
I AIBFTE>AIBZE S $P(@AIBGBLN,"^",2)=AIBFTE
S $P(@AIBGBLN,"^",3)=AIBZN
S $P(@AIBGBLN,"^",4)=AIBZR+AIBRC
S $P(@AIBGBLN,"^",5)=AIBFTL
I AIBFTB<AIBFBD S $P(@AIBGBLF,"^",1)=AIBFTB
I AIBFTE>AIBFED S $P(@AIBGBLF,"^",2)=AIBFTE
S $P(@AIBGBLF,"^",3)=AIBFTR+AIBRC
S $P(@AIBGBLF,"^",4)=AIBCT-1
U AIBCDV
W !!,"Merge Complete"," ",AIBRC
W " Records Merged ",AIBNC," Nodes Merged"
KILLVAR ;KILL LOCAL VARIABLES
K AIBA,AIBCDV,AIBCT
K AIBFBD,AIBFCT,AIBFD,AIBFED,AIBFNM
K AIBFRD,AIBFTB,AIBFTC,AIBFTD,AIBFTE,AIBFTL,AIBFTN,AIBFTR,AIBFTT
K AIBGBL,AIBGBLD,AIBGBLF,AIBGBLN,AIBLK,AIBMSG
K AIBNC,AIBPCC,AIBPSV,AIBR,AIBRC,AIBRM,AIBT2,AIBTONL,AIBTDV,AIBS,AIBV
K AIBW,AIBX,AIBY,AIBZB,AIBZE,AIBZF,AIBZN,AIBZR
K QUIT,X,Y,IO
K AIBANS,AIBCMT,AIBFN,AIBGN,AIBGNL,AIBGNN,AIBGSEL,AIBGV,AIB,%IS,%MT,AIBPARMS,AIBTIME
K AIBSBP,AIBSEL,AIBSEQ,AIBSIZE,AIBT,AIBXX
RETURN ;RETURN TO CALLING ROUTINE
Q
AIBMRG1 ;RPMS/CMB/TJF ;GENERIC GLOBAL MERGE MULTIPLE REEL ROUTINE [ 02/01/89 9:13 AM ]
+1 ;1.3 ;MODIFY TO KILL LOCAL VARIABLES OVERLOOKED IN VER 1.30
+2 ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
+3 ;1.1 ;5/30/88
INIT ;INITIALIZE FIELDS
+1 SET AIBPCC=0
IF '$DATA(U)
SET U="^"
+2 KILL X,AIBGBL,AIBFD
SET AIBSEQ=1
SET (AIBA,AIBMSG)=""
+3 SET (IO(0),AIBCDV)=$IO
IF ^%ZOSF("OS")["MSM"
SET AIBOS="M"
+4 IF '$TEST
SET AIBOS="D"
+5 KILL AIBFBD,AIBFED,AIBS,AIBFTR
+6 DO IN^AIBSDEV
+7 GOTO RETURN
NEXTFILE ;
+1 USE AIBCDV
WRITE !,"Sequence #",AIBSEQ," restored",!
+2 USE AIBDEV
READ AIBXX:DTIME
IF '$TEST
GOTO SEQNO
USE AIBCDV
IF AIBXX="**"
SET QUIT=1
GOTO RETURN
SEQNO USE AIBCDV
WRITE !,"Please put sequence #",AIBSEQ+1," into the drive and"
+1 SET AIBSEQ=AIBSEQ+1
NEXTFIL1 READ !,"Press <RETURN> when ready",AIBXX:DTIME
IF '$TEST
GOTO NEXTFIL1
+1 IF AIBXX?1"?".E
WRITE !!,"Press <RETURN> to continue restoring from sequence #",AIBSEQ,!,"or abort the restore by entering 'control C'"
GOTO NEXTFIL1
+2 DO CLOSE^AIBSDEV
SET IN=1
SET AIBPARMS=AIBPSV
DO OPEN^AIBSDEV
+3 USE AIBDEV
IF '$ZA
READ AIBXX:DTIME
IF '$TEST
GOTO NXTSEQ
+4 IF $ZC
USE AIBCDV
+5 IF '$TEST
WRITE !!,"Cannot access ",AIBFN,", please correct"
GOTO NEXTFIL1
+6 IF AIBXX?2NP1":"2N1" ".E
SET AIBXX=1
+7 IF AIBXX'=AIBSEQ
WRITE !!,"Out of sequence, this file is #",AIBXX,", please correct"
GOTO NEXTFIL1
+8 SET QUIT=0
GOTO RETURN
NXTSEQ ;RETRY ACCESS OF FILE
+1 USE AIBCDV
WRITE !!,"Cannot access ",AIBFN,", please correct"
+2 GOTO NEXTFIL1
FACTSET ;SETUP FACILITY TAPE HEADER VALUES
+1 USE AIBCDV
WRITE AIBGSEL,!
+2 SET AIBGBLP=$EXTRACT(AIBGSEL,2,5)
SET AIBGBL=U_AIBGBLP_"GLOB"
+3 SET AIBGBLN=AIBGBL_"(0)"
+4 SET AIBGBLF=AIBGBL_"(AIBFTL,0)"
+5 SET AIBGBLD=AIBGBL_"(AIBFTL,AIBCT)"
+6 IF AIBPCC
GOTO PCCFACL
+7 SET AIBFD=AIBGV
GOTO GETFCDAT
PCCFACL ;FIND FACILITY LOCATION FOR PCC
+1 SET AIBW=$EXTRACT(AIBGV,21,26)
SET (AIBX,AIBY)=""
SET AIBX=$ORDER(^AUTTLOC("C",AIBW,AIBX))
+2 IF AIBX=""
GOTO BLDPCC
+3 SET AIBY=$PIECE(^AUTTLOC(AIBX,0),U,2)
BLDPCC ;BUILD PCC FACILITY ZEROTH NODE DATA
+1 SET AIBFD=AIBW_U_AIBY_U_U_U_U_U
GETFCDAT ;GET FACILITY DATA FROM INPUT FILE
+1 SET AIBFTL=$PIECE(AIBFD,"^",1)
+2 SET AIBFTN=$PIECE(AIBFD,"^",2)
+3 SET AIBFRD=$PIECE(AIBFD,"^",3)
+4 SET AIBFTB=$PIECE(AIBFD,"^",4)
+5 SET AIBFTE=$PIECE(AIBFD,"^",5)
+6 SET AIBFTT=$PIECE(AIBFD,"^",6)
+7 SET AIBFCT=$PIECE(AIBFD,"^",7)
+8 SET AIBFTC=$PIECE(AIBFD,"^",8)
+9 SET AIBFTD=$PIECE(AIBFD,"^",9)
+10 GOTO RETURN
ZERSET ;
+1 SET AIBZB=$PIECE(@AIBGBLN,"^",1)
+2 SET AIBZE=$PIECE(@AIBGBLN,"^",2)
+3 SET AIBZN=$PIECE(@AIBGBLN,"^",3)
+4 SET AIBZR=$PIECE(@AIBGBLN,"^",4)
+5 SET AIBZF=$PIECE(@AIBGBLN,"^",5)
+6 IF $DATA(@AIBGBLF)
GOTO CKMLOG
+7 SET $PIECE(@AIBGBLF,"^",1)=$PIECE(AIBFD,"^",4)
+8 SET $PIECE(@AIBGBLF,"^",2)=$PIECE(AIBFD,"^",2)
+9 SET $PIECE(@AIBGBLF,"^",3)=0
+10 SET $PIECE(@AIBGBLF,"^",4)=0
+11 SET $PIECE(@AIBGBLF,"^",5)=$PIECE(AIBFD,"^",2)
CKMLOG ;CHECK MERGE LOG FILE
+1 ;D SEARCHM^AIBLOGF
+2 GOTO RETURN
FACSET ;
+1 SET AIBFBD=$PIECE(@AIBGBLF,"^",1)
+2 SET AIBFED=$PIECE(@AIBGBLF,"^",2)
+3 SET AIBFTR=$PIECE(@AIBGBLF,"^",3)
+4 SET AIBS=$PIECE(@AIBGBLF,"^",4)
+5 SET AIBFNM=$PIECE(@AIBGBLF,"^",5)
+6 GOTO RETURN
UPDATE ;BALANCE CHECK
+1 IF $DATA(AIBDEV)
DO CLOSE^AIBSDEV
+2 IF AIBFCT=AIBRC!(AIBPCC)
GOTO COMPUTE
+3 USE AIBCDV
WRITE !!,"# Records Merged and Tape Count Not Equal"
+4 WRITE !,"Tape count was ",AIBFCT
COMPUTE ;UPDATE ZEROTH NODES IN MERGE GLOBAL
+1 IF AIBFTB<AIBZB
SET $PIECE(@AIBGBLN,"^",1)=AIBFTB
+2 IF AIBFTE>AIBZE
SET $PIECE(@AIBGBLN,"^",2)=AIBFTE
+3 SET $PIECE(@AIBGBLN,"^",3)=AIBZN
+4 SET $PIECE(@AIBGBLN,"^",4)=AIBZR+AIBRC
+5 SET $PIECE(@AIBGBLN,"^",5)=AIBFTL
+6 IF AIBFTB<AIBFBD
SET $PIECE(@AIBGBLF,"^",1)=AIBFTB
+7 IF AIBFTE>AIBFED
SET $PIECE(@AIBGBLF,"^",2)=AIBFTE
+8 SET $PIECE(@AIBGBLF,"^",3)=AIBFTR+AIBRC
+9 SET $PIECE(@AIBGBLF,"^",4)=AIBCT-1
+10 USE AIBCDV
+11 WRITE !!,"Merge Complete"," ",AIBRC
+12 WRITE " Records Merged ",AIBNC," Nodes Merged"
KILLVAR ;KILL LOCAL VARIABLES
+1 KILL AIBA,AIBCDV,AIBCT
+2 KILL AIBFBD,AIBFCT,AIBFD,AIBFED,AIBFNM
+3 KILL AIBFRD,AIBFTB,AIBFTC,AIBFTD,AIBFTE,AIBFTL,AIBFTN,AIBFTR,AIBFTT
+4 KILL AIBGBL,AIBGBLD,AIBGBLF,AIBGBLN,AIBLK,AIBMSG
+5 KILL AIBNC,AIBPCC,AIBPSV,AIBR,AIBRC,AIBRM,AIBT2,AIBTONL,AIBTDV,AIBS,AIBV
+6 KILL AIBW,AIBX,AIBY,AIBZB,AIBZE,AIBZF,AIBZN,AIBZR
+7 KILL QUIT,X,Y,IO
+8 KILL AIBANS,AIBCMT,AIBFN,AIBGN,AIBGNL,AIBGNN,AIBGSEL,AIBGV,AIB,%IS,%MT,AIBPARMS,AIBTIME
+9 KILL AIBSBP,AIBSEL,AIBSEQ,AIBSIZE,AIBT,AIBXX
RETURN ;RETURN TO CALLING ROUTINE
+1 QUIT
