source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFQUE4.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1MPIFQUE4 ;SF/TNV-Process the CMOR COMPARISON request ;FEB 25, 1998
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,11,24,27**;30 Apr 99
3 ;
4 ; Integration Agreements Utilized:
5 ;
6 ; EXC^RGHLLOG IA #2796
7 ; START^RGHLLOG IA #2796
8 ; STOP^RGHLLOG IA #2796
9 ; CALC^RGVCCMR2 IA #2710
10 ; $$EN^VAFCPID IA #3015
11 ; ^DGCN(391.91 IA #2751
12 ; FILE^VAFCTFU IA #2988
13 ;
14 ; This routine will process the batch message from the sending CMOR
15 ; who wished to change the patient CMOR from you to their own.
16 ; PLEASE NOTE THAT THIS PROCESS WILL NOT BE TRACKED AS CMOR REQUEST
17 ; EVENT. SO NOTHING WILL BE RECORDED IN THAT FILE. (PER SRS 9-18-97)
18 ; Approving process:
19 ; The sender will give the CMOR score and the date for a patient
20 ; The receiver will look into the CMOR score on the system and compare
21 ; the date if the date is less than 90 days. Go and use the Current
22 ; CMOR score and compare. If the incoming CMOR score is 80% or more than
23 ; the system CMOR score. CMOR site will be changed to the requesting CMOR
24 ; site. An approved HL7 message will be send to ALL SITES in the
25 ; subscriber list and notify them the new CMOR site. MPI is included.
26 ; If the score is equal or greater than 90 days. CMOR score will be
27 ; recalulated for this patient and compare. Same process as above.
28 ; If the incoming CMOR score is not higher than 80% nothing will happen.
29BEGIN ; Entry point for CMOR COMPARISON request to process.
30 ; NO input or output variables
31 N IEN,RGLOG
32 K RGL
33 D NOW^%DTC
34 S ZTIO="",ZTDTH=%,ZTRTN="EN^MPIFQUE4"
35 S ZTDESC="BACKGROUND CMOR COMPARISON"
36 S ZTSAVE("HL*")=""
37 D ^%ZTLOAD,CLEAN
38 K COUNT,RGL,%,ZTIO,ZTDTH,ZTRTN,ZTDESC,ZTSAVE
39 Q
40 ;
41EN ; Background job to run for cmor comparison
42 K ERROR,MPICNT
43 N MPII,U,LINE,PARENT,COUNT,NDATE,IKI,MPIFFS,MPIFSFS,MPIFREAP,RGLOG
44 S MPIFFS=HL("FS"),MPIFSFS=$E(HL("ECH"),1),MPIFREAP=$E(HL("ECH"),2)
45 D START^RGHLLOG()
46 S U="^",(COUNT,MPICNT)=0
47 F MPII=1:1 X HLNEXT Q:HLQUIT'>0!($D(ERROR)) G:$$S^%ZTLOAD CLEAN D
48 . S LINE=HLNODE
49 . I $P(LINE,MPIFFS)["MSH" D MSH
50 . I $P(LINE,MPIFFS)["NTE" D NTE
51 . I $P(LINE,MPIFFS)["PID" D PID
52 . I $P(LINE,MPIFFS)["EVN" D EVN
53 . I COUNT=4,'$D(ERROR) D PROCES
54 K SERVER,CLIENT,ERROR
55 D STOP^RGHLLOG()
56 S ZTREQ="@"
57 Q
58 ;
59MSH ; Process MSH segment
60 S COUNT=COUNT+1
61 Q
62 ;
63NTE ; Process NTE segment
64 S COUNT=COUNT+1
65 S SITE=$P(LINE,MPIFFS,3)
66 I SITE="" S ERROR="HL7 Msg# "_$G(HL("MID"))_" is missing CMOR for ICN# "_$G(ICN) D EXC^RGHLLOG(221,ERROR) Q
67 S REASON=$P(LINE,MPIFFS,2)
68 I REASON'="COMPARISON" S ERROR="HL7 Msg# "_$G(HL("MID"))_" contained a unknown request reason for ICN# "_$G(ICN) D EXC^RGHLLOG(222,ERROR)
69 Q
70 ;
71PID ; Process PID segment
72 N NODE
73 S COUNT=COUNT+1
74 S ICN=+$P(LINE,MPIFFS,3) ; get ICN out.
75 I ICN="" S ERROR="HL7 Msg# "_$G(HL("MID"))_" contains a null ICN in a PID segment." D EXC^RGHLLOG(219,ERROR) Q
76 S DFN=$$IEN^MPIFNQ(ICN) ; get DFN of this patient
77 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
78 S NODE=$$MPINODE^MPIFAPI(+DFN)
79 S CMOR=$P(NODE,"^",3) ; get the CMOR of this patient
80 S SCORE=$P(NODE,"^",6),NDATE=$P(NODE,"^",7)
81 ; if no score or score date recalc score and reset variables
82 I SCORE=""!(NDATE="") N RGDFN S RGDFN=DFN D CALC^RGVCCMR2
83 S NODE=$$MPINODE^MPIFAPI(+DFN),SCORE=$P(NODE,"^",6),NDATE=$P(NODE,"^",7)
84 Q
85 ;
86EVN ; Process EVN segment
87 S COUNT=COUNT+1
88 S X=$P(LINE,MPIFFS,3) D ^%DT S INDATE=Y
89 I INDATE=-1 S ERROR="CMOR score Date was missing for DFN "_DFN_" in CMOR Compare Inbound Message" Q
90 S INSCORE=$P($G(LINE),MPIFFS,4)
91 I INSCORE="" S INSCORE=0
92 Q
93 ;
94PROCES ; Process one complete message (MSH,PID,EVN,NTE)
95 N LIMIT
96 I $G(ERROR)]"" D CLEAN Q ; Don't do anything if there is an error
97 S X="T-90" D ^%DT ; get the target date
98 I NDATE>Y D Q ; RECORDED DATE is less than 90 days
99 . S LIMIT=$$PERCENT(INSCORE,SCORE) ; Incoming CMOR score is above 80%
100 . I (LIMIT>80.5)&(INSCORE>SCORE) D CHANGE ; Incoming CMOR score is greater
101 . D CLEAN ; Incoming CMOR score is LESS
102 N RGDFN S RGDFN=DFN D CALC^RGVCCMR2 ; Last calculation was greater than 90 days
103 S SCORE=$P($$MPINODE^MPIFAPI(DFN),"^",6) ; Get the latest score
104 S LIMIT=$$PERCENT(INSCORE,SCORE) ; Incoming CMOR score is above 80%
105 I (LIMIT>80.5)&(INSCORE>SCORE) D CHANGE ; Incoming CMOR score is greater
106 D CLEAN ; Incoming CMOR score is LESS than the latest score
107 Q
108 ;
109PERCENT(NUM1,NUM2) ; Calculate the percent difference 80% or more need for change
110 ; of CMOR number
111 N DIF
112 I NUM1="" S NUM1=0
113 I NUM2="" S NUM2=0
114 Q:$$MAX^XLFMTH(NUM1,NUM2)=0 0
115 S DIF=(100-(($$MIN^XLFMTH(NUM1,NUM2))/($$MAX^XLFMTH(NUM1,NUM2))*100))
116 Q DIF
117 ;
118CHANGE ; Process the change CMOR request to the new CMOR site and Send out
119 ; notification to the Subscriber list and MPI.
120 N CHANGE,MPIFSITE S MPIFSITE=$$LKUP^XUAF4(SITE) ;get INSTITUTION (#4) IEN
121 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
122 S CHANGE=$$CHANGE^MPIF001(+DFN,MPIFSITE)
123 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
124 S SERVER="MPIF CMOR RESULT SERVER",CLIENT="MPIF CMOR RESULT CLIENT"
125 D INIT^HLFNC2(SERVER,.HL)
126 I $G(HL) S ERROR=HL D EXC^RGHLLOG(220,ERROR,DFN) Q
127 D LINK
128 I $G(RESULT)=0 K RESULT Q
129 S HLA("HLS",1)=$$EN^VAFCPID(+DFN,"2,3,4,5,6,7,8,9,10")
130 S HLA("HLS",2)="EVN"_HL("FS")_"A31"_HL("FS")_INDATE_HL("FS")_INSCORE_HL("FS")_"POSTMASTER"
131 ;actually change the cmor
132 S HLA("HLS",3)="PV1"_HL("FS")_HL("FS")_HL("FS")_SITE_HL("FS")_HL("FS")_HL("FS")_$P($$NNT^XUAF4(CMOR),"^",2)
133 N RESLT
134 D GENERATE^HLMA(SERVER,"LM",1,.RESLT)
135 I $P(RESLT,U,2)'="" D EXC^RGHLLOG(220,"Error returned in GENERATE^HLMA "_$P(RESLT,U,2),DFN)
136 K RESULT
137 S MPICNT=MPICNT+1 ;counting changes in CMOR
138 Q
139 ;
140LINK ; Give back the TF list in HLL(LINKS") array for this patient
141 N CMOR,SUB,IEN,MPILINK,MPITF,PID,CST
142 K RGL
143 S RGL(0)=""
144 S PID=$$GETDFN^MPIF001(ICN)
145 S CMOR=$$GETVCCI^MPIF001(PID),CST=$$IEN^XUAF4(CMOR)
146 I '$D(^DGCN(391.91,"APAT",PID,CST)) D FILE^VAFCTFU(PID,CST,1)
147 S X=$$QUERYTF^VAFCTFU1($G(ICN),"MPITF")
148 ;LOOP THOUGH TF LIST AND GET LINK FOR EACH
149 N LP,CNT,STN,MPIFHL S CNT=1,LP=0 K ERROR
150 F S LP=$O(MPITF(LP)) Q:LP="" D
151 .S STN=$$STA^XUAF4($G(MPITF(LP)))
152 .Q:$P($$SITE^VASITE(),"^",3)=STN
153 .K MPIFHL D LINK^HLUTIL3(+$G(MPITF(LP)),.MPIFHL)
154 .I '$O(MPIFHL(0)) S ERROR="-1^Unknown Logical Link for Station # "_STN_" Unable to notify of Change of CMOR for patient "_DFN
155 .I $D(ERROR) D EXC^RGHLLOG(224,ERROR,DFN) K ERROR Q
156 .S HLL("LINKS",CNT)=CLIENT_"^"_$P(MPIFHL($O(MPIFHL(0))),"^"),CNT=CNT+1
157 S MPILINK=$$MPILINK^MPIFAPI()
158 I +MPILINK=-1 D EXC^RGHLLOG(224,"No MPI Link defined",DFN) Q
159 S HLL("LINKS",9999)=CLIENT_U_MPILINK
160 Q
161CLEAN ; Clean up the partition and ready for the next message
162 D STOP^RGHLLOG()
163 K RGL,EVENT,SITE,REASON,ICN,DFN,CMOR,SCORE,X,Y,INDATE,INSCORE
164 S COUNT=0
165 Q
166CHKSUB(DFN,FAC) ;check for an existing subscription if one does not exist add it
167 Q
168 ;;^ NO LONGER TO BE USED
169 N MPIFSCN,MPIF,MPIFLL,MPIFLLI,MPIFLLN,FLAG,LOOP,HLER
170 Q:FAC=""
171 Q:DFN=""
172 Q:FAC=+$$SITE^VASITE ;don't add subscription for yourself
173 S MPIFSCN=$$GETSCN(DFN)
174 D GET^HLSUB(MPIFSCN,0,"MPIF CMOR RESULT CLIENT",.MPIFLL)
175 D LINK^HLUTIL3("`"_FAC,.MPIF,"I") S MPIFLLI=$O(MPIF(0)) S MPIFLLN=MPIF(MPIFLLI)
176 S FLAG=0,LOOP=0 F S LOOP=$O(MPIFLL("LINKS",LOOP)) Q:'LOOP I $P(MPIFLL("LINKS",LOOP),"^",2)=MPIFLLN S FLAG=1
177 I FLAG=0 D UPD^HLSUB(MPIFSCN,MPIFLLN,0,$$NOW^XLFDT,,,.HLER)
178 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
179 Q
180GETSCN(DFN) ;Return existing SCN or Activate a new subscription
181 ;DFN - PATIENT (#2) file ien
182 N MPIFAR,MPIFAN
183 ;get subscription control #
184 S MPIFSCN=+$P($$MPINODE^MPIFAPI(DFN),"^",5)
185 ;if no SCN, create new and update 991.05, then return result
186 I 'MPIFSCN S MPIFSCN=$$ACT^HLSUB S MPIFAR(991.05)=MPIFSCN S MPIFAN=$$UPDATE^MPIFAPI(DFN,"MPIFAR") I MPIFAN=-1 S MPIFSCN=""
187 Q MPIFSCN
Note: See TracBrowser for help on using the repository browser.