AIBMRG ;RPMS/CMB/TJF ;GENERIC IBM DATA GLOBAL MERGE ROUTINE [ 02/01/89 8:29 AM ]
;1.3; 1/13/89 DISALLOW MULTIPLE MERGES FOR A SINGLE FACILITY
;1.3 ;ALLOW READ DSM ON MSM, CHS LOGIC & DISALLOW MULTIPLE MERGE
;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY AND PCC FILES
;1.00 ;2/12/88
INTRO ;INITIALIZATION LOGIC
S:'$D(DTIME) DTIME=300 S:'$D(AIBFFN) AIBFFN=""
W !,"GENERIC MERGE FILE TO GLOBAL PROGRAM FOR IBM RECORDS"
BEGIN ;ENTRY POINT FOR FRONT END TELECOMMUNICATIONS PROGRAM AIBTCFLM
D INIT^AIBMRG1 G:AIBA="A" ABEND G:AIBA="C" OPCANCL S AIBPSV=AIBPARMS
U AIBDEV R AIBTIME:DTIME X AIBTONL G:'$T FILERROR
I $E(AIBTIME)="~"!($E(AIBTIME)="|") G PCCMSG
G READCMT
PCCMSG ;SET SWITCH FOR PCC LOGIC AND DISPLAY MESSAGE
S AIBPCC=1
U AIBCDV W !,"Begin merging Patient Care Component records"
S AIBGV=AIBTIME G PCCGBLNM
READCMT ;READ COMMENT FROM SAVED GLOBAL FILE
U AIBDEV R AIBCMT:DTIME X AIBTONL G:'$T FILERROR I AIBTIME="" G FILERROR
U AIBCDV S AIBSEQ=1
W !!,"Global saved at ",AIBTIME,".",!,"Header comment is : ",AIBCMT,!
START ;BEGIN MERGING FILE
U AIBCDV W !!,"Begin Merging of Global: "
NEXTGBL ;PROCESS NEXT FILE
K AIBGSEL
NEXTVOL ;PROCESS NEXT VOLUME OF FILE
U AIBDEV I AIBPCC G SKIPSUBZ
R AIBGN:DTIME X AIBTONL G:'$T FILERROR
SKIPSUBZ ;SKIP READ OF ZEROTH NODE SUBSCRIPT DATA - PCC FLAT FILE
R AIBGV:DTIME X AIBTONL G:'$T FILERROR G:AIBPCC PCCGBLNM
I AIBGN="*E" D NEXTFILE^AIBMRG1 G NEXTVOL:'QUIT
G ENDFILE:AIBGN="**",FILERROR:AIBGN="",NEXTGBL:AIBGN="*"
I $E(AIBGN)="*" S AIBGSEL=$E(AIBGN,2,999) G NEXTVOL
S AIBGNN=$P(AIBGN,"("),AIBGNL=$L(AIBGNN)+1 S:'$D(AIBGSEL) AIBGSEL=AIBGNN
I $L(AIBGV)>0 G INITINDR
I AIBOS="D" G NEXTGBL
R "INPUT FILE APPEARS TO IN DSM FORMAT, IS THIS CORRECT? (Y,N) Y// ",X:DTIME I X["N" G FILERROR
G NEXTGBL
PCCGBLNM ;INITIALIZE GLOBAL PREFIX NAME FOR PCC
S (AIBGSEL,AIBGNN)="^APCC",AIBGNL=6
INITINDR ;INITIALIZE INDIRECTION VARIABLES
D FACTSET^AIBMRG1
I $D(@AIBGBLN) G RTVGTZN
S @AIBGBLN="9999999^0^0^0^0"
RTVGTZN ;RETREVE VARIABLES FROM GRAND TOTAL ZEROTH NODE IN MERGE GLOBAL
D ZERSET^AIBMRG1 G:AIBA="A" ABEND
S AIBZN=AIBZN+1
RTVFCZN ;RETREIVE FACILITY DATA FROM ZEROTH FACILITY NODE IN MERGE GLOBAL
D FACSET^AIBMRG1 G:AIBA="A" ABEND
I AIBS>0 G:AIBGSEL["AGTX" NOMRG G:AIBGSEL["APCC" NOMRG
S AIBCT=AIBS+1
S (AIBRC,AIBNC)=0
I AIBPCC S (AIBRC,AIBNC)=1 G BLDNODE
READ ;READ NEXT RECORD NODE DATA FROM INPUT FILE
U AIBDEV I AIBPCC G SKIPSUBD
R AIBGN:DTIME X AIBTONL G:'$T FILERROR
SKIPSUBD ;SKIP SUBSCRIPTS FOR DATA RECORDS - PCC FLAT FILE
R AIBGV:DTIME X AIBTONL G:'$T FILERROR G:AIBPCC CKPCCEOF
G:AIBGN="" FILERROR I AIBGN="*E" D NEXTFILE^AIBMRG1 G READ:'QUIT
G:$E(AIBGN,1,7)="**END**" ENDFILE ; OKC FORMAT
I AIBGN="*" U AIBCDV W !," ... Global Merged" G NEXTGBL
G NEXTGBL:AIBGN="*",ENDFILE:AIBGN="**"
G BLDNODE
CKPCCEOF ;END OF FILE LOGIC FOR PCC FLAT FILE
G:$E(AIBGV)="~"!($E(AIBGV)="|") SETPCCID G ENDFILE
SETPCCID ;SET NODE ID PIECE FOR PCC
S AIBGV="PCC"_U_AIBGV
BLDNODE ;PLACE DATA IN MERGE GLOBAL RECORD NODE
S:"^ACHS"=$E(AIBGSEL,1,5) AIBGV="CHS"_U_AIBGV
S @AIBGBLD=AIBGV
S AIBCT=AIBCT+1,AIBNC=AIBNC+1 I $E(AIBGV,1,3)'="RG1" S AIBRC=AIBRC+1
E G READ
U AIBCDV S AIBRM=AIBRC#10 G:AIBRM>0 READ
S AIBLK="",AIBLK=AIBLK_$J("",8-$L(AIBRC)) W AIBLK,AIBRC G READ
ENDFILE ;END OF FILE PROCESSING
D UPDATE^AIBMRG1
I AIBFFN=2 G QUIT
R !,"Merge Another? Y// ",AIBA:DTIME
S:AIBA="" AIBA="Y" G:"YESyes"[AIBA BEGIN G QUIT
NOMRG ;DISALLOW MULTIPLE MERGE FOR A FACILITY
S AIBMSG="Records for this facility already on file - additional merge not allowed" G ABEND
FILERROR ;ERROR IN FILE FORMAT - ABEND AFTER MESSAGE
S AIBMSG="Invalid backup format...unable to merge."
ABEND ;ABNORMAL END OF JOB
D ABEND^AIBCVT6 D KILLVAR^AIBMRG1 G QUIT
OPCANCL ;ABEND BECAUSE OPERATOR CANCLED JOB
D OPCANCL^AIBCVT6 D KILLVAR^AIBMRG1 G QUIT
QUIT ;
K AIBOS G RETURN
RETURN ;RETURN TO CALLING PROGRAM
Q
AIBMRG ;RPMS/CMB/TJF ;GENERIC IBM DATA GLOBAL MERGE ROUTINE [ 02/01/89 8:29 AM ]
+1 ;1.3; 1/13/89 DISALLOW MULTIPLE MERGES FOR A SINGLE FACILITY
+2 ;1.3 ;ALLOW READ DSM ON MSM, CHS LOGIC & DISALLOW MULTIPLE MERGE
+3 ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY AND PCC FILES
+4 ;1.00 ;2/12/88
INTRO ;INITIALIZATION LOGIC
+1 IF '$DATA(DTIME)
SET DTIME=300
IF '$DATA(AIBFFN)
SET AIBFFN=""
+2 WRITE !,"GENERIC MERGE FILE TO GLOBAL PROGRAM FOR IBM RECORDS"
BEGIN ;ENTRY POINT FOR FRONT END TELECOMMUNICATIONS PROGRAM AIBTCFLM
+1 DO INIT^AIBMRG1
IF AIBA="A"
GOTO ABEND
IF AIBA="C"
GOTO OPCANCL
SET AIBPSV=AIBPARMS
+2 USE AIBDEV
READ AIBTIME:DTIME
XECUTE AIBTONL
IF '$TEST
GOTO FILERROR
+3 IF $EXTRACT(AIBTIME)="~"!($EXTRACT(AIBTIME)="|")
GOTO PCCMSG
+4 GOTO READCMT
PCCMSG ;SET SWITCH FOR PCC LOGIC AND DISPLAY MESSAGE
+1 SET AIBPCC=1
+2 USE AIBCDV
WRITE !,"Begin merging Patient Care Component records"
+3 SET AIBGV=AIBTIME
GOTO PCCGBLNM
READCMT ;READ COMMENT FROM SAVED GLOBAL FILE
+1 USE AIBDEV
READ AIBCMT:DTIME
XECUTE AIBTONL
IF '$TEST
GOTO FILERROR
IF AIBTIME=""
GOTO FILERROR
+2 USE AIBCDV
SET AIBSEQ=1
+3 WRITE !!,"Global saved at ",AIBTIME,".",!,"Header comment is : ",AIBCMT,!
START ;BEGIN MERGING FILE
+1 USE AIBCDV
WRITE !!,"Begin Merging of Global: "
NEXTGBL ;PROCESS NEXT FILE
+1 KILL AIBGSEL
NEXTVOL ;PROCESS NEXT VOLUME OF FILE
+1 USE AIBDEV
IF AIBPCC
GOTO SKIPSUBZ
+2 READ AIBGN:DTIME
XECUTE AIBTONL
IF '$TEST
GOTO FILERROR
SKIPSUBZ ;SKIP READ OF ZEROTH NODE SUBSCRIPT DATA - PCC FLAT FILE
+1 READ AIBGV:DTIME
XECUTE AIBTONL
IF '$TEST
GOTO FILERROR
IF AIBPCC
GOTO PCCGBLNM
+2 IF AIBGN="*E"
DO NEXTFILE^AIBMRG1
IF 'QUIT
GOTO NEXTVOL
+3 IF AIBGN="**"
GOTO ENDFILE
IF AIBGN=""
GOTO FILERROR
IF AIBGN="*"
GOTO NEXTGBL
+4 IF $EXTRACT(AIBGN)="*"
SET AIBGSEL=$EXTRACT(AIBGN,2,999)
GOTO NEXTVOL
+5 SET AIBGNN=$PIECE(AIBGN,"(")
SET AIBGNL=$LENGTH(AIBGNN)+1
IF '$DATA(AIBGSEL)
SET AIBGSEL=AIBGNN
+6 IF $LENGTH(AIBGV)>0
GOTO INITINDR
+7 IF AIBOS="D"
GOTO NEXTGBL
+8 READ "INPUT FILE APPEARS TO IN DSM FORMAT, IS THIS CORRECT? (Y,N) Y// ",X:DTIME
IF X["N"
GOTO FILERROR
+9 GOTO NEXTGBL
PCCGBLNM ;INITIALIZE GLOBAL PREFIX NAME FOR PCC
+1 SET (AIBGSEL,AIBGNN)="^APCC"
SET AIBGNL=6
INITINDR ;INITIALIZE INDIRECTION VARIABLES
+1 DO FACTSET^AIBMRG1
+2 IF $DATA(@AIBGBLN)
GOTO RTVGTZN
+3 SET @AIBGBLN="9999999^0^0^0^0"
RTVGTZN ;RETREVE VARIABLES FROM GRAND TOTAL ZEROTH NODE IN MERGE GLOBAL
+1 DO ZERSET^AIBMRG1
IF AIBA="A"
GOTO ABEND
+2 SET AIBZN=AIBZN+1
RTVFCZN ;RETREIVE FACILITY DATA FROM ZEROTH FACILITY NODE IN MERGE GLOBAL
+1 DO FACSET^AIBMRG1
IF AIBA="A"
GOTO ABEND
+2 IF AIBS>0
IF AIBGSEL["AGTX"
GOTO NOMRG
IF AIBGSEL["APCC"
GOTO NOMRG
+3 SET AIBCT=AIBS+1
+4 SET (AIBRC,AIBNC)=0
+5 IF AIBPCC
SET (AIBRC,AIBNC)=1
GOTO BLDNODE
READ ;READ NEXT RECORD NODE DATA FROM INPUT FILE
+1 USE AIBDEV
IF AIBPCC
GOTO SKIPSUBD
+2 READ AIBGN:DTIME
XECUTE AIBTONL
IF '$TEST
GOTO FILERROR
SKIPSUBD ;SKIP SUBSCRIPTS FOR DATA RECORDS - PCC FLAT FILE
+1 READ AIBGV:DTIME
XECUTE AIBTONL
IF '$TEST
GOTO FILERROR
IF AIBPCC
GOTO CKPCCEOF
+2 IF AIBGN=""
GOTO FILERROR
IF AIBGN="*E"
DO NEXTFILE^AIBMRG1
IF 'QUIT
GOTO READ
+3 ; OKC FORMAT
IF $EXTRACT(AIBGN,1,7)="**END**"
GOTO ENDFILE
+4 IF AIBGN="*"
USE AIBCDV
WRITE !," ... Global Merged"
GOTO NEXTGBL
+5 IF AIBGN="*"
GOTO NEXTGBL
IF AIBGN="**"
GOTO ENDFILE
+6 GOTO BLDNODE
CKPCCEOF ;END OF FILE LOGIC FOR PCC FLAT FILE
+1 IF $EXTRACT(AIBGV)="~"!($EXTRACT(AIBGV)="|")
GOTO SETPCCID
GOTO ENDFILE
SETPCCID ;SET NODE ID PIECE FOR PCC
+1 SET AIBGV="PCC"_U_AIBGV
BLDNODE ;PLACE DATA IN MERGE GLOBAL RECORD NODE
+1 IF "^ACHS"=$EXTRACT(AIBGSEL,1,5)
SET AIBGV="CHS"_U_AIBGV
+2 SET @AIBGBLD=AIBGV
+3 SET AIBCT=AIBCT+1
SET AIBNC=AIBNC+1
IF $EXTRACT(AIBGV,1,3)'="RG1"
SET AIBRC=AIBRC+1
+4 IF '$TEST
GOTO READ
+5 USE AIBCDV
SET AIBRM=AIBRC#10
IF AIBRM>0
GOTO READ
+6 SET AIBLK=""
SET AIBLK=AIBLK_$JUSTIFY("",8-$LENGTH(AIBRC))
WRITE AIBLK,AIBRC
GOTO READ
ENDFILE ;END OF FILE PROCESSING
+1 DO UPDATE^AIBMRG1
+2 IF AIBFFN=2
GOTO QUIT
+3 READ !,"Merge Another? Y// ",AIBA:DTIME
+4 IF AIBA=""
SET AIBA="Y"
IF "YESyes"[AIBA
GOTO BEGIN
GOTO QUIT
NOMRG ;DISALLOW MULTIPLE MERGE FOR A FACILITY
+1 SET AIBMSG="Records for this facility already on file - additional merge not allowed"
GOTO ABEND
FILERROR ;ERROR IN FILE FORMAT - ABEND AFTER MESSAGE
+1 SET AIBMSG="Invalid backup format...unable to merge."
ABEND ;ABNORMAL END OF JOB
+1 DO ABEND^AIBCVT6
DO KILLVAR^AIBMRG1
GOTO QUIT
OPCANCL ;ABEND BECAUSE OPERATOR CANCLED JOB
+1 DO OPCANCL^AIBCVT6
DO KILLVAR^AIBMRG1
GOTO QUIT
QUIT ;
+1 KILL AIBOS
GOTO RETURN
RETURN ;RETURN TO CALLING PROGRAM
+1 QUIT
