- 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
