MPIFMER ;SF/MJM,CMC-Merge patient ICN ;JUL 14, 1998
;;1.0; MASTER PATIENT INDEX VISTA ;**9,21**;30 Apr 99
;
; *** THIS ROUTINE IS TO BE REPLACED BY THE LINK/UNLINK MESSAGES
; *** SINCE MESSAGES ARE NOT BEING USED BY ANYONE, PLACING QUIT
; **** AT ALL ENTRY POINTS.
;
;Notify MPI and other TF of change to patient's ICN
;
MER(PDFN,OLD,ERROR,FLG) ;
Q
;Q:$D(MPIFMER)
;Q:$E(OLD,1,3)=$E($P($$SITE^VASITE,"^",3),1,3)
;; ^ LOCAL ICN being resolved don't send to CIRN sites OR MPI
;; but others may want to know Local Resolved,
;;If other want to know resolved look at x-ref on 991.01 field in file 2
;I '$G(PDFN) S ERROR="DFN VARIABLE UNDEFINED" Q
;Q:OLD=""
;I '$D(FLG) S FLG=""
;I '$D(ERROR) S ERROR=""
;S ZTRTN="MER2^MPIFMER",ZTDESC="MERGE ICN JOB",ZTIO=""
;D NOW^%DTC S ZTDTH=% K %,X
;I $D(DUZ) S ZTSAVE("DUZ")=DUZ
;S ZTSAVE("PDFN")=PDFN,ZTSAVE("OLD")=OLD,ZTSAVE("ERROR")=ERROR,ZTSAVE("FLG")=FLG
;D ^%ZTLOAD
;K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
;Q
MER2 ;
Q
;N RGLOG,CNT,HLA,HL,RGLINK,HOME,SUB,ICN,TMP,PARENT,RGL,CLIENT,I,TD,X,CMOR,HERE,%
;Q:$E(OLD,1,3)=$E($P($$SITE^VASITE,"^",3),1,3)
;; ^ LOCAL ICN being resolved don't send to CIRN sites or MPI
;; though others may want to know Local has been resolved.
;;If other want to know resolved look at x-ref on 991.01 field in file 2
;Q:'$G(PDFN)
;Q:+$$GETICN^MPIF001(PDFN)<0
;; ^ If no ICN currently don't send mesg
;S CNT=0,HL=0,ERROR="",CLIENT="MPIF A30 SERVER"
;D NOW^%DTC S TD=$$HLDATE^HLFNC(%,"DT")
;S CMOR=+$$PAT^MPIFNQ(PDFN),HERE=+$$SITE^VASITE()
;I CMOR'=HERE,FLG="" S ERROR="PATIENT'S CMOR MUST BE THIS FACILITY" D EXC^MPIFDEL(PDFN,ERROR,226) Q
;D INIT^HLFNC2(CLIENT,.HL)
;I HL S ERROR=HL D EXC^MPIFDEL(PDFN,ERROR,220) Q
;S CNT=CNT+1,HLA("HLS",CNT)="EVN"_HL("FS")_"A30"_HL("FS")_TD_HL("FS")_HL("FS")_HL("FS")
;S CNT=CNT+1,HLA("HLS",CNT)=$$EN^VAFCPID(PDFN,"1,2,3,4,5,6,7,8,10,13,14,17,19,11")
;S CNT=CNT+1,HLA("HLS",CNT)="MRG"_HL("FS")_OLD
;D GENERATE^HLMA(CLIENT,"LM",1,.HLRST,"",.HL)
;I 'HLRST S ERROR=HLRST D EXC^MPIFDEL(PDFN,ERROR,220)
;Q
LINKS ; gets links to send messages to, including mpi
; Currently only the MPI will get Change ICN msgs.
Q
;N SUB,MPI
;Q:$P($$GETICN^MPIF001(PDFN),1,3)=$P($$SITE^VASITE(),3)
;S SUB=$P($G(^DPT(PDFN,"MPI")),"^",5)
;I SUB'="" D GET^HLSUB(SUB,0,"MPIF A30",.HLL)
;S MPI=$$MPILINK^MPIFAPI() D
;.I $P($G(MPI),U)'=-1 S HLL("LINKS",999)="MPIF A30"_"^"_MPI
;.I $P($G(MPI),U)=-1 N RGLOG D START^RGHLLOG(HLMTIEN,"","") D EXC^RGHLLOG(224,"No MPI link defined in CIRN Site Parameter file") D STOP^RGHLLOG(0)
;Q
;
IN ;process inbound Merge ICN Message - currently not used.
Q
;N I,CNT,NODE,SENDER,NEWICN,OLDICN,PDFN,CMOR,ERR,DA,DIE,DR,SEP,CHK
;K ^XTMP($J,"MPIFMER")
;; get message
;F I=1:1 X HLNEXT Q:HLQUIT'>0 S ^XTMP($J,"MPIFMER","IN",I)=HLNODE
;; ^XTMP($J,"MPIFMER","IN",I look for data
;S CNT=0
;F S CNT=$O(^XTMP($J,"MPIFMER","IN",CNT)) Q:CNT="" D
;.S NODE=$G(^XTMP($J,"MPIFMER","IN",CNT))
;.I $E(NODE,1,3)="MSH" S SEP=$E(NODE,4),SENDER=$P(NODE,SEP,4) Q:'$D(SEP)
;.I $P(NODE,SEP)="EVN" Q:$P(NODE,SEP,2)'="A30"
;.I $P(NODE,SEP)="PID" S NEWICN=+$P(NODE,SEP,3),CHK=$P($P(NODE,SEP,3),"V",2) Q:NEWICN=""
;.I $P(NODE,SEP)="MRG" S OLDICN=+$P(NODE,SEP,2) Q:OLDICN=""
;;
;Q:'$D(OLDICN)
;Q:'$D(^DPT("AICN",OLDICN))
;; ^ old icn not at site
;S PDFN=""
;F S PDFN=$O(^DPT("AICN",OLDICN,PDFN)) Q:PDFN="" D
;.; incase have multiple OLD-ICNs
;.S CMOR=$$PAT^MPIFNQ(PDFN)
;.I CMOR'=SENDER S ERR="MERGE ICN MESSAGE DID NOT COME FROM CMOR for Patient dfn="_PDFN D EXC^MPIFDEL(PDFN,ERR,226) Q
;.K DA,DIE,DR
;.S DA=PDFN,DIE="^DPT(",DR="991.01////"_NEWICN_";991.02////"_CHK,MPIFMER=""
;.D ^DIE K MPIFMER
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFMER 3740 printed Oct 16, 2024@18:11:57 Page 2
MPIFMER ;SF/MJM,CMC-Merge patient ICN ;JUL 14, 1998
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**9,21**;30 Apr 99
+2 ;
+3 ; *** THIS ROUTINE IS TO BE REPLACED BY THE LINK/UNLINK MESSAGES
+4 ; *** SINCE MESSAGES ARE NOT BEING USED BY ANYONE, PLACING QUIT
+5 ; **** AT ALL ENTRY POINTS.
+6 ;
+7 ;Notify MPI and other TF of change to patient's ICN
+8 ;
MER(PDFN,OLD,ERROR,FLG) ;
+1 QUIT
+2 ;Q:$D(MPIFMER)
+3 ;Q:$E(OLD,1,3)=$E($P($$SITE^VASITE,"^",3),1,3)
+4 ;; ^ LOCAL ICN being resolved don't send to CIRN sites OR MPI
+5 ;; but others may want to know Local Resolved,
+6 ;;If other want to know resolved look at x-ref on 991.01 field in file 2
+7 ;I '$G(PDFN) S ERROR="DFN VARIABLE UNDEFINED" Q
+8 ;Q:OLD=""
+9 ;I '$D(FLG) S FLG=""
+10 ;I '$D(ERROR) S ERROR=""
+11 ;S ZTRTN="MER2^MPIFMER",ZTDESC="MERGE ICN JOB",ZTIO=""
+12 ;D NOW^%DTC S ZTDTH=% K %,X
+13 ;I $D(DUZ) S ZTSAVE("DUZ")=DUZ
+14 ;S ZTSAVE("PDFN")=PDFN,ZTSAVE("OLD")=OLD,ZTSAVE("ERROR")=ERROR,ZTSAVE("FLG")=FLG
+15 ;D ^%ZTLOAD
+16 ;K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+17 ;Q
MER2 ;
+1 QUIT
+2 ;N RGLOG,CNT,HLA,HL,RGLINK,HOME,SUB,ICN,TMP,PARENT,RGL,CLIENT,I,TD,X,CMOR,HERE,%
+3 ;Q:$E(OLD,1,3)=$E($P($$SITE^VASITE,"^",3),1,3)
+4 ;; ^ LOCAL ICN being resolved don't send to CIRN sites or MPI
+5 ;; though others may want to know Local has been resolved.
+6 ;;If other want to know resolved look at x-ref on 991.01 field in file 2
+7 ;Q:'$G(PDFN)
+8 ;Q:+$$GETICN^MPIF001(PDFN)<0
+9 ;; ^ If no ICN currently don't send mesg
+10 ;S CNT=0,HL=0,ERROR="",CLIENT="MPIF A30 SERVER"
+11 ;D NOW^%DTC S TD=$$HLDATE^HLFNC(%,"DT")
+12 ;S CMOR=+$$PAT^MPIFNQ(PDFN),HERE=+$$SITE^VASITE()
+13 ;I CMOR'=HERE,FLG="" S ERROR="PATIENT'S CMOR MUST BE THIS FACILITY" D EXC^MPIFDEL(PDFN,ERROR,226) Q
+14 ;D INIT^HLFNC2(CLIENT,.HL)
+15 ;I HL S ERROR=HL D EXC^MPIFDEL(PDFN,ERROR,220) Q
+16 ;S CNT=CNT+1,HLA("HLS",CNT)="EVN"_HL("FS")_"A30"_HL("FS")_TD_HL("FS")_HL("FS")_HL("FS")
+17 ;S CNT=CNT+1,HLA("HLS",CNT)=$$EN^VAFCPID(PDFN,"1,2,3,4,5,6,7,8,10,13,14,17,19,11")
+18 ;S CNT=CNT+1,HLA("HLS",CNT)="MRG"_HL("FS")_OLD
+19 ;D GENERATE^HLMA(CLIENT,"LM",1,.HLRST,"",.HL)
+20 ;I 'HLRST S ERROR=HLRST D EXC^MPIFDEL(PDFN,ERROR,220)
+21 ;Q
LINKS ; gets links to send messages to, including mpi
+1 ; Currently only the MPI will get Change ICN msgs.
+2 QUIT
+3 ;N SUB,MPI
+4 ;Q:$P($$GETICN^MPIF001(PDFN),1,3)=$P($$SITE^VASITE(),3)
+5 ;S SUB=$P($G(^DPT(PDFN,"MPI")),"^",5)
+6 ;I SUB'="" D GET^HLSUB(SUB,0,"MPIF A30",.HLL)
+7 ;S MPI=$$MPILINK^MPIFAPI() D
+8 ;.I $P($G(MPI),U)'=-1 S HLL("LINKS",999)="MPIF A30"_"^"_MPI
+9 ;.I $P($G(MPI),U)=-1 N RGLOG D START^RGHLLOG(HLMTIEN,"","") D EXC^RGHLLOG(224,"No MPI link defined in CIRN Site Parameter file") D STOP^RGHLLOG(0)
+10 ;Q
+11 ;
IN ;process inbound Merge ICN Message - currently not used.
+1 QUIT
+2 ;N I,CNT,NODE,SENDER,NEWICN,OLDICN,PDFN,CMOR,ERR,DA,DIE,DR,SEP,CHK
+3 ;K ^XTMP($J,"MPIFMER")
+4 ;; get message
+5 ;F I=1:1 X HLNEXT Q:HLQUIT'>0 S ^XTMP($J,"MPIFMER","IN",I)=HLNODE
+6 ;; ^XTMP($J,"MPIFMER","IN",I look for data
+7 ;S CNT=0
+8 ;F S CNT=$O(^XTMP($J,"MPIFMER","IN",CNT)) Q:CNT="" D
+9 ;.S NODE=$G(^XTMP($J,"MPIFMER","IN",CNT))
+10 ;.I $E(NODE,1,3)="MSH" S SEP=$E(NODE,4),SENDER=$P(NODE,SEP,4) Q:'$D(SEP)
+11 ;.I $P(NODE,SEP)="EVN" Q:$P(NODE,SEP,2)'="A30"
+12 ;.I $P(NODE,SEP)="PID" S NEWICN=+$P(NODE,SEP,3),CHK=$P($P(NODE,SEP,3),"V",2) Q:NEWICN=""
+13 ;.I $P(NODE,SEP)="MRG" S OLDICN=+$P(NODE,SEP,2) Q:OLDICN=""
+14 ;;
+15 ;Q:'$D(OLDICN)
+16 ;Q:'$D(^DPT("AICN",OLDICN))
+17 ;; ^ old icn not at site
+18 ;S PDFN=""
+19 ;F S PDFN=$O(^DPT("AICN",OLDICN,PDFN)) Q:PDFN="" D
+20 ;.; incase have multiple OLD-ICNs
+21 ;.S CMOR=$$PAT^MPIFNQ(PDFN)
+22 ;.I CMOR'=SENDER S ERR="MERGE ICN MESSAGE DID NOT COME FROM CMOR for Patient dfn="_PDFN D EXC^MPIFDEL(PDFN,ERR,226) Q
+23 ;.K DA,DIE,DR
+24 ;.S DA=PDFN,DIE="^DPT(",DR="991.01////"_NEWICN_";991.02////"_CHK,MPIFMER=""
+25 ;.D ^DIE K MPIFMER
+26 ;Q
