- 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