MPIFQUE4 ;SF/TNV-Process the CMOR COMPARISON request ;FEB 25, 1998
;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,11,24,27**;30 Apr 99
;
; Integration Agreements Utilized:
;
; EXC^RGHLLOG IA #2796
; START^RGHLLOG IA #2796
; STOP^RGHLLOG IA #2796
; CALC^RGVCCMR2 IA #2710
; $$EN^VAFCPID IA #3015
; ^DGCN(391.91 IA #2751
; FILE^VAFCTFU IA #2988
;
; This routine will process the batch message from the sending CMOR
; who wished to change the patient CMOR from you to their own.
; PLEASE NOTE THAT THIS PROCESS WILL NOT BE TRACKED AS CMOR REQUEST
; EVENT. SO NOTHING WILL BE RECORDED IN THAT FILE. (PER SRS 9-18-97)
; Approving process:
; The sender will give the CMOR score and the date for a patient
; The receiver will look into the CMOR score on the system and compare
; the date if the date is less than 90 days. Go and use the Current
; CMOR score and compare. If the incoming CMOR score is 80% or more than
; the system CMOR score. CMOR site will be changed to the requesting CMOR
; site. An approved HL7 message will be send to ALL SITES in the
; subscriber list and notify them the new CMOR site. MPI is included.
; If the score is equal or greater than 90 days. CMOR score will be
; recalulated for this patient and compare. Same process as above.
; If the incoming CMOR score is not higher than 80% nothing will happen.
BEGIN ; Entry point for CMOR COMPARISON request to process.
; NO input or output variables
N IEN,RGLOG
K RGL
D NOW^%DTC
S ZTIO="",ZTDTH=%,ZTRTN="EN^MPIFQUE4"
S ZTDESC="BACKGROUND CMOR COMPARISON"
S ZTSAVE("HL*")=""
D ^%ZTLOAD,CLEAN
K COUNT,RGL,%,ZTIO,ZTDTH,ZTRTN,ZTDESC,ZTSAVE
Q
;
EN ; Background job to run for cmor comparison
K ERROR,MPICNT
N MPII,U,LINE,PARENT,COUNT,NDATE,IKI,MPIFFS,MPIFSFS,MPIFREAP,RGLOG
S MPIFFS=HL("FS"),MPIFSFS=$E(HL("ECH"),1),MPIFREAP=$E(HL("ECH"),2)
D START^RGHLLOG()
S U="^",(COUNT,MPICNT)=0
F MPII=1:1 X HLNEXT Q:HLQUIT'>0!($D(ERROR)) G:$$S^%ZTLOAD CLEAN D
. S LINE=HLNODE
. I $P(LINE,MPIFFS)["MSH" D MSH
. I $P(LINE,MPIFFS)["NTE" D NTE
. I $P(LINE,MPIFFS)["PID" D PID
. I $P(LINE,MPIFFS)["EVN" D EVN
. I COUNT=4,'$D(ERROR) D PROCES
K SERVER,CLIENT,ERROR
D STOP^RGHLLOG()
S ZTREQ="@"
Q
;
MSH ; Process MSH segment
S COUNT=COUNT+1
Q
;
NTE ; Process NTE segment
S COUNT=COUNT+1
S SITE=$P(LINE,MPIFFS,3)
I SITE="" S ERROR="HL7 Msg# "_$G(HL("MID"))_" is missing CMOR for ICN# "_$G(ICN) D EXC^RGHLLOG(221,ERROR) Q
S REASON=$P(LINE,MPIFFS,2)
I REASON'="COMPARISON" S ERROR="HL7 Msg# "_$G(HL("MID"))_" contained a unknown request reason for ICN# "_$G(ICN) D EXC^RGHLLOG(222,ERROR)
Q
;
PID ; Process PID segment
N NODE
S COUNT=COUNT+1
S ICN=+$P(LINE,MPIFFS,3) ; get ICN out.
I ICN="" S ERROR="HL7 Msg# "_$G(HL("MID"))_" contains a null ICN in a PID segment." D EXC^RGHLLOG(219,ERROR) Q
S DFN=$$IEN^MPIFNQ(ICN) ; get DFN of this patient
I DFN="" S ERROR="Can't Process CMOR Compare for Patient with ICN "_ICN_". ICN not at this site. HL7 Message#: "_HLMTIEN D EXC^RGHLLOG(219,ERROR) Q
S NODE=$$MPINODE^MPIFAPI(+DFN)
S CMOR=$P(NODE,"^",3) ; get the CMOR of this patient
S SCORE=$P(NODE,"^",6),NDATE=$P(NODE,"^",7)
; if no score or score date recalc score and reset variables
I SCORE=""!(NDATE="") N RGDFN S RGDFN=DFN D CALC^RGVCCMR2
S NODE=$$MPINODE^MPIFAPI(+DFN),SCORE=$P(NODE,"^",6),NDATE=$P(NODE,"^",7)
Q
;
EVN ; Process EVN segment
S COUNT=COUNT+1
S X=$P(LINE,MPIFFS,3) D ^%DT S INDATE=Y
I INDATE=-1 S ERROR="CMOR score Date was missing for DFN "_DFN_" in CMOR Compare Inbound Message" Q
S INSCORE=$P($G(LINE),MPIFFS,4)
I INSCORE="" S INSCORE=0
Q
;
PROCES ; Process one complete message (MSH,PID,EVN,NTE)
N LIMIT
I $G(ERROR)]"" D CLEAN Q ; Don't do anything if there is an error
S X="T-90" D ^%DT ; get the target date
I NDATE>Y D Q ; RECORDED DATE is less than 90 days
. S LIMIT=$$PERCENT(INSCORE,SCORE) ; Incoming CMOR score is above 80%
. I (LIMIT>80.5)&(INSCORE>SCORE) D CHANGE ; Incoming CMOR score is greater
. D CLEAN ; Incoming CMOR score is LESS
N RGDFN S RGDFN=DFN D CALC^RGVCCMR2 ; Last calculation was greater than 90 days
S SCORE=$P($$MPINODE^MPIFAPI(DFN),"^",6) ; Get the latest score
S LIMIT=$$PERCENT(INSCORE,SCORE) ; Incoming CMOR score is above 80%
I (LIMIT>80.5)&(INSCORE>SCORE) D CHANGE ; Incoming CMOR score is greater
D CLEAN ; Incoming CMOR score is LESS than the latest score
Q
;
PERCENT(NUM1,NUM2) ; Calculate the percent difference 80% or more need for change
; of CMOR number
N DIF
I NUM1="" S NUM1=0
I NUM2="" S NUM2=0
Q:$$MAX^XLFMTH(NUM1,NUM2)=0 0
S DIF=(100-(($$MIN^XLFMTH(NUM1,NUM2))/($$MAX^XLFMTH(NUM1,NUM2))*100))
Q DIF
;
CHANGE ; Process the change CMOR request to the new CMOR site and Send out
; notification to the Subscriber list and MPI.
N CHANGE,MPIFSITE S MPIFSITE=$$LKUP^XUAF4(SITE) ;get INSTITUTION (#4) IEN
I MPIFSITE=-1 S ERROR="HL7 Msg#"_$G(HL("MID"))_" contained an invalid STATION#"_$G(SITE)_" for ICN#"_$G(ICN) D EXC^RGHLLOG(211,ERROR,+DFN) Q
S CHANGE=$$CHANGE^MPIF001(+DFN,MPIFSITE)
I +CHANGE<1 S ERROR="Unable to change CMOR in HL7 Msg#"_$G(HL("MID"))_" from "_$P($$SITE^VASITE,"^",3)_" To "_$G(SITE)_" due to "_$P(CHANGE,"^",2) D EXC^RGHLLOG(211,ERROR,DFN) Q
S SERVER="MPIF CMOR RESULT SERVER",CLIENT="MPIF CMOR RESULT CLIENT"
D INIT^HLFNC2(SERVER,.HL)
I $G(HL) S ERROR=HL D EXC^RGHLLOG(220,ERROR,DFN) Q
D LINK
I $G(RESULT)=0 K RESULT Q
S HLA("HLS",1)=$$EN^VAFCPID(+DFN,"2,3,4,5,6,7,8,9,10")
S HLA("HLS",2)="EVN"_HL("FS")_"A31"_HL("FS")_INDATE_HL("FS")_INSCORE_HL("FS")_"POSTMASTER"
;actually change the cmor
S HLA("HLS",3)="PV1"_HL("FS")_HL("FS")_HL("FS")_SITE_HL("FS")_HL("FS")_HL("FS")_$P($$NNT^XUAF4(CMOR),"^",2)
N RESLT
D GENERATE^HLMA(SERVER,"LM",1,.RESLT)
I $P(RESLT,U,2)'="" D EXC^RGHLLOG(220,"Error returned in GENERATE^HLMA "_$P(RESLT,U,2),DFN)
K RESULT
S MPICNT=MPICNT+1 ;counting changes in CMOR
Q
;
LINK ; Give back the TF list in HLL(LINKS") array for this patient
N CMOR,SUB,IEN,MPILINK,MPITF,PID,CST
K RGL
S RGL(0)=""
S PID=$$GETDFN^MPIF001(ICN)
S CMOR=$$GETVCCI^MPIF001(PID),CST=$$IEN^XUAF4(CMOR)
I '$D(^DGCN(391.91,"APAT",PID,CST)) D FILE^VAFCTFU(PID,CST,1)
S X=$$QUERYTF^VAFCTFU1($G(ICN),"MPITF")
;LOOP THOUGH TF LIST AND GET LINK FOR EACH
N LP,CNT,STN,MPIFHL S CNT=1,LP=0 K ERROR
F S LP=$O(MPITF(LP)) Q:LP="" D
.S STN=$$STA^XUAF4($G(MPITF(LP)))
.Q:$P($$SITE^VASITE(),"^",3)=STN
.K MPIFHL D LINK^HLUTIL3(+$G(MPITF(LP)),.MPIFHL)
.I '$O(MPIFHL(0)) S ERROR="-1^Unknown Logical Link for Station # "_STN_" Unable to notify of Change of CMOR for patient "_DFN
.I $D(ERROR) D EXC^RGHLLOG(224,ERROR,DFN) K ERROR Q
.S HLL("LINKS",CNT)=CLIENT_"^"_$P(MPIFHL($O(MPIFHL(0))),"^"),CNT=CNT+1
S MPILINK=$$MPILINK^MPIFAPI()
I +MPILINK=-1 D EXC^RGHLLOG(224,"No MPI Link defined",DFN) Q
S HLL("LINKS",9999)=CLIENT_U_MPILINK
Q
CLEAN ; Clean up the partition and ready for the next message
D STOP^RGHLLOG()
K RGL,EVENT,SITE,REASON,ICN,DFN,CMOR,SCORE,X,Y,INDATE,INSCORE
S COUNT=0
Q
CHKSUB(DFN,FAC) ;check for an existing subscription if one does not exist add it
Q
;;^ NO LONGER TO BE USED
N MPIFSCN,MPIF,MPIFLL,MPIFLLI,MPIFLLN,FLAG,LOOP,HLER
Q:FAC=""
Q:DFN=""
Q:FAC=+$$SITE^VASITE ;don't add subscription for yourself
S MPIFSCN=$$GETSCN(DFN)
D GET^HLSUB(MPIFSCN,0,"MPIF CMOR RESULT CLIENT",.MPIFLL)
D LINK^HLUTIL3("`"_FAC,.MPIF,"I") S MPIFLLI=$O(MPIF(0)) S MPIFLLN=MPIF(MPIFLLI)
S FLAG=0,LOOP=0 F S LOOP=$O(MPIFLL("LINKS",LOOP)) Q:'LOOP I $P(MPIFLL("LINKS",LOOP),"^",2)=MPIFLLN S FLAG=1
I FLAG=0 D UPD^HLSUB(MPIFSCN,MPIFLLN,0,$$NOW^XLFDT,,,.HLER)
I $D(HLER) D EXC^RGHLLOG(224,"Msg#"_$G(HL("MID"))_" Unable to add/update SC for facility IEN "_FAC_", Link "_$G(MPIFLLN)_", for patient "_DFN_" SUB#"_$G(MPIFSCN),DFN) D STOP^RGHLLOG(1) Q ; log exception
Q
GETSCN(DFN) ;Return existing SCN or Activate a new subscription
;DFN - PATIENT (#2) file ien
N MPIFAR,MPIFAN
;get subscription control #
S MPIFSCN=+$P($$MPINODE^MPIFAPI(DFN),"^",5)
;if no SCN, create new and update 991.05, then return result
I 'MPIFSCN S MPIFSCN=$$ACT^HLSUB S MPIFAR(991.05)=MPIFSCN S MPIFAN=$$UPDATE^MPIFAPI(DFN,"MPIFAR") I MPIFAN=-1 S MPIFSCN=""
Q MPIFSCN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFQUE4 8559 printed Dec 13, 2024@02:11:31 Page 2
MPIFQUE4 ;SF/TNV-Process the CMOR COMPARISON request ;FEB 25, 1998
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,11,24,27**;30 Apr 99
+2 ;
+3 ; Integration Agreements Utilized:
+4 ;
+5 ; EXC^RGHLLOG IA #2796
+6 ; START^RGHLLOG IA #2796
+7 ; STOP^RGHLLOG IA #2796
+8 ; CALC^RGVCCMR2 IA #2710
+9 ; $$EN^VAFCPID IA #3015
+10 ; ^DGCN(391.91 IA #2751
+11 ; FILE^VAFCTFU IA #2988
+12 ;
+13 ; This routine will process the batch message from the sending CMOR
+14 ; who wished to change the patient CMOR from you to their own.
+15 ; PLEASE NOTE THAT THIS PROCESS WILL NOT BE TRACKED AS CMOR REQUEST
+16 ; EVENT. SO NOTHING WILL BE RECORDED IN THAT FILE. (PER SRS 9-18-97)
+17 ; Approving process:
+18 ; The sender will give the CMOR score and the date for a patient
+19 ; The receiver will look into the CMOR score on the system and compare
+20 ; the date if the date is less than 90 days. Go and use the Current
+21 ; CMOR score and compare. If the incoming CMOR score is 80% or more than
+22 ; the system CMOR score. CMOR site will be changed to the requesting CMOR
+23 ; site. An approved HL7 message will be send to ALL SITES in the
+24 ; subscriber list and notify them the new CMOR site. MPI is included.
+25 ; If the score is equal or greater than 90 days. CMOR score will be
+26 ; recalulated for this patient and compare. Same process as above.
+27 ; If the incoming CMOR score is not higher than 80% nothing will happen.
BEGIN ; Entry point for CMOR COMPARISON request to process.
+1 ; NO input or output variables
+2 NEW IEN,RGLOG
+3 KILL RGL
+4 DO NOW^%DTC
+5 SET ZTIO=""
SET ZTDTH=%
SET ZTRTN="EN^MPIFQUE4"
+6 SET ZTDESC="BACKGROUND CMOR COMPARISON"
+7 SET ZTSAVE("HL*")=""
+8 DO ^%ZTLOAD
DO CLEAN
+9 KILL COUNT,RGL,%,ZTIO,ZTDTH,ZTRTN,ZTDESC,ZTSAVE
+10 QUIT
+11 ;
EN ; Background job to run for cmor comparison
+1 KILL ERROR,MPICNT
+2 NEW MPII,U,LINE,PARENT,COUNT,NDATE,IKI,MPIFFS,MPIFSFS,MPIFREAP,RGLOG
+3 SET MPIFFS=HL("FS")
SET MPIFSFS=$EXTRACT(HL("ECH"),1)
SET MPIFREAP=$EXTRACT(HL("ECH"),2)
+4 DO START^RGHLLOG()
+5 SET U="^"
SET (COUNT,MPICNT)=0
+6 FOR MPII=1:1
XECUTE HLNEXT
if HLQUIT'>0!($DATA(ERROR))
QUIT
if $$S^%ZTLOAD
GOTO CLEAN
Begin DoDot:1
+7 SET LINE=HLNODE
+8 IF $PIECE(LINE,MPIFFS)["MSH"
DO MSH
+9 IF $PIECE(LINE,MPIFFS)["NTE"
DO NTE
+10 IF $PIECE(LINE,MPIFFS)["PID"
DO PID
+11 IF $PIECE(LINE,MPIFFS)["EVN"
DO EVN
+12 IF COUNT=4
IF '$DATA(ERROR)
DO PROCES
End DoDot:1
+13 KILL SERVER,CLIENT,ERROR
+14 DO STOP^RGHLLOG()
+15 SET ZTREQ="@"
+16 QUIT
+17 ;
MSH ; Process MSH segment
+1 SET COUNT=COUNT+1
+2 QUIT
+3 ;
NTE ; Process NTE segment
+1 SET COUNT=COUNT+1
+2 SET SITE=$PIECE(LINE,MPIFFS,3)
+3 IF SITE=""
SET ERROR="HL7 Msg# "_$GET(HL("MID"))_" is missing CMOR for ICN# "_$GET(ICN)
DO EXC^RGHLLOG(221,ERROR)
QUIT
+4 SET REASON=$PIECE(LINE,MPIFFS,2)
+5 IF REASON'="COMPARISON"
SET ERROR="HL7 Msg# "_$GET(HL("MID"))_" contained a unknown request reason for ICN# "_$GET(ICN)
DO EXC^RGHLLOG(222,ERROR)
+6 QUIT
+7 ;
PID ; Process PID segment
+1 NEW NODE
+2 SET COUNT=COUNT+1
+3 ; get ICN out.
SET ICN=+$PIECE(LINE,MPIFFS,3)
+4 IF ICN=""
SET ERROR="HL7 Msg# "_$GET(HL("MID"))_" contains a null ICN in a PID segment."
DO EXC^RGHLLOG(219,ERROR)
QUIT
+5 ; get DFN of this patient
SET DFN=$$IEN^MPIFNQ(ICN)
+6 IF DFN=""
SET ERROR="Can't Process CMOR Compare for Patient with ICN "_ICN_". ICN not at this site. HL7 Message#: "_HLMTIEN
DO EXC^RGHLLOG(219,ERROR)
QUIT
+7 SET NODE=$$MPINODE^MPIFAPI(+DFN)
+8 ; get the CMOR of this patient
SET CMOR=$PIECE(NODE,"^",3)
+9 SET SCORE=$PIECE(NODE,"^",6)
SET NDATE=$PIECE(NODE,"^",7)
+10 ; if no score or score date recalc score and reset variables
+11 IF SCORE=""!(NDATE="")
NEW RGDFN
SET RGDFN=DFN
DO CALC^RGVCCMR2
+12 SET NODE=$$MPINODE^MPIFAPI(+DFN)
SET SCORE=$PIECE(NODE,"^",6)
SET NDATE=$PIECE(NODE,"^",7)
+13 QUIT
+14 ;
EVN ; Process EVN segment
+1 SET COUNT=COUNT+1
+2 SET X=$PIECE(LINE,MPIFFS,3)
DO ^%DT
SET INDATE=Y
+3 IF INDATE=-1
SET ERROR="CMOR score Date was missing for DFN "_DFN_" in CMOR Compare Inbound Message"
QUIT
+4 SET INSCORE=$PIECE($GET(LINE),MPIFFS,4)
+5 IF INSCORE=""
SET INSCORE=0
+6 QUIT
+7 ;
PROCES ; Process one complete message (MSH,PID,EVN,NTE)
+1 NEW LIMIT
+2 ; Don't do anything if there is an error
IF $GET(ERROR)]""
DO CLEAN
QUIT
+3 ; get the target date
SET X="T-90"
DO ^%DT
+4 ; RECORDED DATE is less than 90 days
IF NDATE>Y
Begin DoDot:1
+5 ; Incoming CMOR score is above 80%
SET LIMIT=$$PERCENT(INSCORE,SCORE)
+6 ; Incoming CMOR score is greater
IF (LIMIT>80.5)&(INSCORE>SCORE)
DO CHANGE
+7 ; Incoming CMOR score is LESS
DO CLEAN
End DoDot:1
QUIT
+8 ; Last calculation was greater than 90 days
NEW RGDFN
SET RGDFN=DFN
DO CALC^RGVCCMR2
+9 ; Get the latest score
SET SCORE=$PIECE($$MPINODE^MPIFAPI(DFN),"^",6)
+10 ; Incoming CMOR score is above 80%
SET LIMIT=$$PERCENT(INSCORE,SCORE)
+11 ; Incoming CMOR score is greater
IF (LIMIT>80.5)&(INSCORE>SCORE)
DO CHANGE
+12 ; Incoming CMOR score is LESS than the latest score
DO CLEAN
+13 QUIT
+14 ;
PERCENT(NUM1,NUM2) ; Calculate the percent difference 80% or more need for change
+1 ; of CMOR number
+2 NEW DIF
+3 IF NUM1=""
SET NUM1=0
+4 IF NUM2=""
SET NUM2=0
+5 if $$MAX^XLFMTH(NUM1,NUM2)=0
QUIT 0
+6 SET DIF=(100-(($$MIN^XLFMTH(NUM1,NUM2))/($$MAX^XLFMTH(NUM1,NUM2))*100))
+7 QUIT DIF
+8 ;
CHANGE ; Process the change CMOR request to the new CMOR site and Send out
+1 ; notification to the Subscriber list and MPI.
+2 ;get INSTITUTION (#4) IEN
NEW CHANGE,MPIFSITE
SET MPIFSITE=$$LKUP^XUAF4(SITE)
+3 IF MPIFSITE=-1
SET ERROR="HL7 Msg#"_$GET(HL("MID"))_" contained an invalid STATION#"_$GET(SITE)_" for ICN#"_$GET(ICN)
DO EXC^RGHLLOG(211,ERROR,+DFN)
QUIT
+4 SET CHANGE=$$CHANGE^MPIF001(+DFN,MPIFSITE)
+5 IF +CHANGE<1
SET ERROR="Unable to change CMOR in HL7 Msg#"_$GET(HL("MID"))_" from "_$PIECE($$SITE^VASITE,"^",3)_" To "_$GET(SITE)_" due to "_$PIECE(CHANGE,"^",2)
DO EXC^RGHLLOG(211,ERROR,DFN)
QUIT
+6 SET SERVER="MPIF CMOR RESULT SERVER"
SET CLIENT="MPIF CMOR RESULT CLIENT"
+7 DO INIT^HLFNC2(SERVER,.HL)
+8 IF $GET(HL)
SET ERROR=HL
DO EXC^RGHLLOG(220,ERROR,DFN)
QUIT
+9 DO LINK
+10 IF $GET(RESULT)=0
KILL RESULT
QUIT
+11 SET HLA("HLS",1)=$$EN^VAFCPID(+DFN,"2,3,4,5,6,7,8,9,10")
+12 SET HLA("HLS",2)="EVN"_HL("FS")_"A31"_HL("FS")_INDATE_HL("FS")_INSCORE_HL("FS")_"POSTMASTER"
+13 ;actually change the cmor
+14 SET HLA("HLS",3)="PV1"_HL("FS")_HL("FS")_HL("FS")_SITE_HL("FS")_HL("FS")_HL("FS")_$PIECE($$NNT^XUAF4(CMOR),"^",2)
+15 NEW RESLT
+16 DO GENERATE^HLMA(SERVER,"LM",1,.RESLT)
+17 IF $PIECE(RESLT,U,2)'=""
DO EXC^RGHLLOG(220,"Error returned in GENERATE^HLMA "_$PIECE(RESLT,U,2),DFN)
+18 KILL RESULT
+19 ;counting changes in CMOR
SET MPICNT=MPICNT+1
+20 QUIT
+21 ;
LINK ; Give back the TF list in HLL(LINKS") array for this patient
+1 NEW CMOR,SUB,IEN,MPILINK,MPITF,PID,CST
+2 KILL RGL
+3 SET RGL(0)=""
+4 SET PID=$$GETDFN^MPIF001(ICN)
+5 SET CMOR=$$GETVCCI^MPIF001(PID)
SET CST=$$IEN^XUAF4(CMOR)
+6 IF '$DATA(^DGCN(391.91,"APAT",PID,CST))
DO FILE^VAFCTFU(PID,CST,1)
+7 SET X=$$QUERYTF^VAFCTFU1($GET(ICN),"MPITF")
+8 ;LOOP THOUGH TF LIST AND GET LINK FOR EACH
+9 NEW LP,CNT,STN,MPIFHL
SET CNT=1
SET LP=0
KILL ERROR
+10 FOR
SET LP=$ORDER(MPITF(LP))
if LP=""
QUIT
Begin DoDot:1
+11 SET STN=$$STA^XUAF4($GET(MPITF(LP)))
+12 if $PIECE($$SITE^VASITE(),"^",3)=STN
QUIT
+13 KILL MPIFHL
DO LINK^HLUTIL3(+$GET(MPITF(LP)),.MPIFHL)
+14 IF '$ORDER(MPIFHL(0))
SET ERROR="-1^Unknown Logical Link for Station # "_STN_" Unable to notify of Change of CMOR for patient "_DFN
+15 IF $DATA(ERROR)
DO EXC^RGHLLOG(224,ERROR,DFN)
KILL ERROR
QUIT
+16 SET HLL("LINKS",CNT)=CLIENT_"^"_$PIECE(MPIFHL($ORDER(MPIFHL(0))),"^")
SET CNT=CNT+1
End DoDot:1
+17 SET MPILINK=$$MPILINK^MPIFAPI()
+18 IF +MPILINK=-1
DO EXC^RGHLLOG(224,"No MPI Link defined",DFN)
QUIT
+19 SET HLL("LINKS",9999)=CLIENT_U_MPILINK
+20 QUIT
CLEAN ; Clean up the partition and ready for the next message
+1 DO STOP^RGHLLOG()
+2 KILL RGL,EVENT,SITE,REASON,ICN,DFN,CMOR,SCORE,X,Y,INDATE,INSCORE
+3 SET COUNT=0
+4 QUIT
CHKSUB(DFN,FAC) ;check for an existing subscription if one does not exist add it
+1 QUIT
+2 ;;^ NO LONGER TO BE USED
+3 NEW MPIFSCN,MPIF,MPIFLL,MPIFLLI,MPIFLLN,FLAG,LOOP,HLER
+4 if FAC=""
QUIT
+5 if DFN=""
QUIT
+6 ;don't add subscription for yourself
if FAC=+$$SITE^VASITE
QUIT
+7 SET MPIFSCN=$$GETSCN(DFN)
+8 DO GET^HLSUB(MPIFSCN,0,"MPIF CMOR RESULT CLIENT",.MPIFLL)
+9 DO LINK^HLUTIL3("`"_FAC,.MPIF,"I")
SET MPIFLLI=$ORDER(MPIF(0))
SET MPIFLLN=MPIF(MPIFLLI)
+10 SET FLAG=0
SET LOOP=0
FOR
SET LOOP=$ORDER(MPIFLL("LINKS",LOOP))
if 'LOOP
QUIT
IF $PIECE(MPIFLL("LINKS",LOOP),"^",2)=MPIFLLN
SET FLAG=1
+11 IF FLAG=0
DO UPD^HLSUB(MPIFSCN,MPIFLLN,0,$$NOW^XLFDT,,,.HLER)
+12 ; log exception
IF $DATA(HLER)
DO EXC^RGHLLOG(224,"Msg#"_$GET(HL("MID"))_" Unable to add/update SC for facility IEN "_FAC_", Link "_$GET(MPIFLLN)_", for patient "_DFN_" SUB#"_$GET(MPIFSCN),DFN)
DO STOP^RGHLLOG(1)
QUIT
+13 QUIT
GETSCN(DFN) ;Return existing SCN or Activate a new subscription
+1 ;DFN - PATIENT (#2) file ien
+2 NEW MPIFAR,MPIFAN
+3 ;get subscription control #
+4 SET MPIFSCN=+$PIECE($$MPINODE^MPIFAPI(DFN),"^",5)
+5 ;if no SCN, create new and update 991.05, then return result
+6 IF 'MPIFSCN
SET MPIFSCN=$$ACT^HLSUB
SET MPIFAR(991.05)=MPIFSCN
SET MPIFAN=$$UPDATE^MPIFAPI(DFN,"MPIFAR")
IF MPIFAN=-1
SET MPIFSCN=""
+7 QUIT MPIFSCN
