RGFIPM ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**5**;30 Apr 99
;
XCHANGE(DFN,LEGSN,PRIMSN,ERROR) ;
;Description: If the CMOR is the legacy site it changes to the
;primary site. If the legacy system is on the treating facility list
;it is removed. If the primary system is not on the treating facility
;list it is added.The subscription for the legacy system is terminated.
;If the primary system is not on the subscriber list it is added.
;
;Input:
; DFN - ien of patient (required)
; LEGSN- station # of the legacy site (required)-
; PRIMSN - station # of the primary site (required)
;Output:
; Function Value - 0 if any error condition encountered, 1 otherwise
; ERROR() - (optional,pass by reference) - an array of error messages
;
;Variables:
; PRIMIEN - ien of the primary site in the Institution file
; PRIMLINK - name of logical link for primary site
; FOUNDERR - flag set to 1 if an error is found
; MPIDATA() - array containing MPI data for this patient
;
N PRIMIEN,PRIMLINK,FOUNDERR,MPIDATA,RETURN,LEGIEN
;
D
.S FOUNDERR=0
.I DFN,LEGSN,PRIMSN
.E D ADDERROR("INPUT PARAMETER MISSING, TAG=XCHANGE,RTN=RGFIPM",6) Q
.;
.S PRIMIEN=$$LKUP^XUAF4(PRIMSN)
.I 'PRIMIEN D ADDERROR("INSTITUTION LOOKUP FAILED, STATION# = "_PRIMSN,229) Q
.S LEGIEN=$$LKUP^XUAF4(LEGSN)
.I 'LEGIEN D ADDERROR("INSTITUTION LOOKUP FAILED, STATION# = "_LEGSN,229)
.;
.D GETALL^RGFIU(DFN,.MPIDATA)
.;
.;if the legacy site is the CMOR change it to the primary site
.I MPIDATA("CMOR")=LEGSN,($$CHANGE^MPIF001(DFN,PRIMIEN)'=1) D ADDERROR("ERROR CHANGING CMOR TO "_PRIMSN,6)
.;
.;if the legacy system is on the TF list, remove it
.I $D(MPIDATA("TF",LEGSN)) S RETURN=$$DELETETF^VAFCTFU(MPIDATA("ICN"),MPIDATA("TF",LEGSN,"INSTIEN")) I +RETURN D ADDERROR("FAILURE TO DELETE TREATING FACILITY = "_LEGSN,6)
.;
.;if the primary site is not on the TF list, then add it OR
.;its on the Tf list but with an earlier date than the legacy and legacy has an event reason OR legacy has an event reason and primary doesn't, change it
.I ('$D(MPIDATA("TF",PRIMSN)))!($G(MPIDATA("TF",PRIMSN,"LASTDATE"))<$G(MPIDATA("TF",LEGSN,"LASTDATE"))&$G(MPIDATA("TF",LEGSN,"EVENT")))!($G(MPIDATA("TF",LEGSN,"EVENT"))&('$G(MPIDATA("TF",PRIMSN,"EVENT")))) D
..;should not be necessar to delete old TF entry for primary before calling FILE^VACTFU
..;I $D(MPIDATA("TF",PRIMSN)) S RETURN=$$DELETETF^VAFCTFU(MPIDATA("ICN"),MPIDATA("TF",PRIMSN,"INSTIEN"))
..;
..D FILE^VAFCTFU(DFN,PRIMIEN_"^"_$G(MPIDATA("TF",LEGSN,"LASTDATE"))_"^"_$G(MPIDATA("TF",LEGSN,"EVENT")),1)
.;
.Q:'MPIDATA("SUB")
.;Terminate the subscription of legacy site
.I LEGIEN,LEGIEN'=+$$SITE^VASITE D UPD^HLSUB(MPIDATA("SUB"),$$GETLINK^RGFIU(LEGIEN),,,$$NOW^XLFDT)
.;
.;if the primary site is not on the subscription list then add it - unless this site is the primary site!
.D
..Q:(($P($$SITE^VASITE(),"^",3))=PRIMSN)
..;Add primary site as a subscriber
..N ERR
..;Get the logical link for the primary site
..S PRIMLINK=$$GETLINK^RGFIU(PRIMIEN)
..I PRIMLINK="" D ADDERROR("FAILURE TO ADD SUBSCRIPTION FOR STATION# = "_PRIMSN,224) Q
..D UPD^HLSUB(MPIDATA("SUB"),PRIMLINK,0,,"@",,.ERR)
..I $O(ERR(0)) D ADDERROR("FAILURE TO ADD SUBSCRIPTION FOR STATION# = "_PRIMSN,6)
Q $S(FOUNDERR:0,1:1)
;
ADDERROR(MSG,CODE) ;
;Description: Puts the error message on a list. If an exception type code is passed the exception handler will be called.
;
;Input:
; MSG - message text
; CODE - a CIRN exception type (optional)
; ERROR() - this is the array where errors are being tracked
; DFN - the patient DFN should be defined
;Output:
; ERROR() array has the addtional error entered
; FOUNDERR is set to 1, is a flag indicating that an error was encountered
;
N NEXT
S FOUNDERR=1
S NEXT=($O(ERROR(-1))+1)
S ERROR(NEXT)=MSG
S ERROR(NEXT,"CODE")=$G(CODE)
I $G(CODE),$G(DFN) D EXC^RGFIU(CODE,"FACILITY INTEGRATION ERROR: "_$P($$ERROR^RGFIPM1(MSG,CODE,$$ICN^RGFIU(DFN)),"^",2),DFN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGFIPM 4109 printed Dec 13, 2024@01:41:50 Page 2
RGFIPM ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5**;30 Apr 99
+2 ;
XCHANGE(DFN,LEGSN,PRIMSN,ERROR) ;
+1 ;Description: If the CMOR is the legacy site it changes to the
+2 ;primary site. If the legacy system is on the treating facility list
+3 ;it is removed. If the primary system is not on the treating facility
+4 ;list it is added.The subscription for the legacy system is terminated.
+5 ;If the primary system is not on the subscriber list it is added.
+6 ;
+7 ;Input:
+8 ; DFN - ien of patient (required)
+9 ; LEGSN- station # of the legacy site (required)-
+10 ; PRIMSN - station # of the primary site (required)
+11 ;Output:
+12 ; Function Value - 0 if any error condition encountered, 1 otherwise
+13 ; ERROR() - (optional,pass by reference) - an array of error messages
+14 ;
+15 ;Variables:
+16 ; PRIMIEN - ien of the primary site in the Institution file
+17 ; PRIMLINK - name of logical link for primary site
+18 ; FOUNDERR - flag set to 1 if an error is found
+19 ; MPIDATA() - array containing MPI data for this patient
+20 ;
+21 NEW PRIMIEN,PRIMLINK,FOUNDERR,MPIDATA,RETURN,LEGIEN
+22 ;
+23 Begin DoDot:1
+24 SET FOUNDERR=0
+25 IF DFN
IF LEGSN
IF PRIMSN
+26 IF '$TEST
DO ADDERROR("INPUT PARAMETER MISSING, TAG=XCHANGE,RTN=RGFIPM",6)
QUIT
+27 ;
+28 SET PRIMIEN=$$LKUP^XUAF4(PRIMSN)
+29 IF 'PRIMIEN
DO ADDERROR("INSTITUTION LOOKUP FAILED, STATION# = "_PRIMSN,229)
QUIT
+30 SET LEGIEN=$$LKUP^XUAF4(LEGSN)
+31 IF 'LEGIEN
DO ADDERROR("INSTITUTION LOOKUP FAILED, STATION# = "_LEGSN,229)
+32 ;
+33 DO GETALL^RGFIU(DFN,.MPIDATA)
+34 ;
+35 ;if the legacy site is the CMOR change it to the primary site
+36 IF MPIDATA("CMOR")=LEGSN
IF ($$CHANGE^MPIF001(DFN,PRIMIEN)'=1)
DO ADDERROR("ERROR CHANGING CMOR TO "_PRIMSN,6)
+37 ;
+38 ;if the legacy system is on the TF list, remove it
+39 IF $DATA(MPIDATA("TF",LEGSN))
SET RETURN=$$DELETETF^VAFCTFU(MPIDATA("ICN"),MPIDATA("TF",LEGSN,"INSTIEN"))
IF +RETURN
DO ADDERROR("FAILURE TO DELETE TREATING FACILITY = "_LEGSN,6)
+40 ;
+41 ;if the primary site is not on the TF list, then add it OR
+42 ;its on the Tf list but with an earlier date than the legacy and legacy has an event reason OR legacy has an event reason and primary doesn't, change it
+43 IF ('$DATA(MPIDATA("TF",PRIMSN)))!($GET(MPIDATA("TF",PRIMSN,"LASTDATE"))<$GET(MPIDATA("TF",LEGSN,"LASTDATE"))&$GET(MPIDATA("TF",LEGSN,"EVENT")))!($GET(MPIDATA("TF",LEGSN,"EVENT"))&('$GET(MPIDATA("TF",PRIMSN,"EVENT"))))
Begin DoDot:2
+44 ;should not be necessar to delete old TF entry for primary before calling FILE^VACTFU
+45 ;I $D(MPIDATA("TF",PRIMSN)) S RETURN=$$DELETETF^VAFCTFU(MPIDATA("ICN"),MPIDATA("TF",PRIMSN,"INSTIEN"))
+46 ;
+47 DO FILE^VAFCTFU(DFN,PRIMIEN_"^"_$GET(MPIDATA("TF",LEGSN,"LASTDATE"))_"^"_$GET(MPIDATA("TF",LEGSN,"EVENT")),1)
End DoDot:2
+48 ;
+49 if 'MPIDATA("SUB")
QUIT
+50 ;Terminate the subscription of legacy site
+51 IF LEGIEN
IF LEGIEN'=+$$SITE^VASITE
DO UPD^HLSUB(MPIDATA("SUB"),$$GETLINK^RGFIU(LEGIEN),,,$$NOW^XLFDT)
+52 ;
+53 ;if the primary site is not on the subscription list then add it - unless this site is the primary site!
+54 Begin DoDot:2
+55 if (($PIECE($$SITE^VASITE(),"^",3))=PRIMSN)
QUIT
+56 ;Add primary site as a subscriber
+57 NEW ERR
+58 ;Get the logical link for the primary site
+59 SET PRIMLINK=$$GETLINK^RGFIU(PRIMIEN)
+60 IF PRIMLINK=""
DO ADDERROR("FAILURE TO ADD SUBSCRIPTION FOR STATION# = "_PRIMSN,224)
QUIT
+61 DO UPD^HLSUB(MPIDATA("SUB"),PRIMLINK,0,,"@",,.ERR)
+62 IF $ORDER(ERR(0))
DO ADDERROR("FAILURE TO ADD SUBSCRIPTION FOR STATION# = "_PRIMSN,6)
End DoDot:2
End DoDot:1
+63 QUIT $SELECT(FOUNDERR:0,1:1)
+64 ;
ADDERROR(MSG,CODE) ;
+1 ;Description: Puts the error message on a list. If an exception type code is passed the exception handler will be called.
+2 ;
+3 ;Input:
+4 ; MSG - message text
+5 ; CODE - a CIRN exception type (optional)
+6 ; ERROR() - this is the array where errors are being tracked
+7 ; DFN - the patient DFN should be defined
+8 ;Output:
+9 ; ERROR() array has the addtional error entered
+10 ; FOUNDERR is set to 1, is a flag indicating that an error was encountered
+11 ;
+12 NEW NEXT
+13 SET FOUNDERR=1
+14 SET NEXT=($ORDER(ERROR(-1))+1)
+15 SET ERROR(NEXT)=MSG
+16 SET ERROR(NEXT,"CODE")=$GET(CODE)
+17 IF $GET(CODE)
IF $GET(DFN)
DO EXC^RGFIU(CODE,"FACILITY INTEGRATION ERROR: "_$PIECE($$ERROR^RGFIPM1(MSG,CODE,$$ICN^RGFIU(DFN)),"^",2),DFN)
+18 QUIT
