source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFRES.m@ 1211

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1MPIFRES ;SF/CMC-LOCAL AND MISSING ICN RESOLUTION ;JUL 13, 1998
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,7,10,15,17,21,26,28,33,35,43,39**;30 Apr 99;Build 3
3 ;
4 ; Integration Agreements Utilized:
5 ; EXC, START and STOP^RGHLLOG - #2796
6 ; ^DPT("AICNL", ^DPT("AMPIMIS" - #2070
7 ; ^RGHL7(991.1 - #3259
8 ; ^RGSITE - #2746
9 ;
10BKG ;
11 I $D(ZTQUEUED) D GO Q
12 S ZTRTN="GO^MPIFRES",ZTDESC="USE HL7 MSGS AND MAIL TO BUILD ICN"
13 S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
14 I $D(DUZ) S ZTSAVE("DUZ")=DUZ
15 D ^%ZTLOAD
16 D HOME^%ZIS K IO("Q")
17 K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
18 Q
19 ;
20GO ;ENTRY POINT
21 N MPIMORE,MPITOT
22 L +^XTMP("MPIF RESOLUTION"):3 E Q
23 I $D(ZTQUEUED) S ZTREQ="@"
24 ;
25 K ^TMP("HLS",$J),STOP
26 D START^RGHLLOG()
27 D HLRDF
28 I $D(STOP) K STOP Q ;patch 7 added to quit if init returned an error
29 D LOOP
30 I $D(^TMP("HLS",$J)) D SEND
31 D STOP^RGHLLOG(0)
32 K MPIIT,MPITOT,HLDT,HLDT1,MPICNT,MPIDNUM,MPIEROR,MPIMIDT,MPIMSH
33 K MPIOUT,MPIQRYNM,MPISEQ,QCNT,MPIMCNT,MPIMTX,ENDT,MPIFRES
34 L -^XTMP("MPIF RESOLUTION")
35 ; mark job completion date/time
36 S $P(^RGSITE(991.8,1,0),"^",4)=$$NOW^XLFDT
37 Q
38 ;
39HLRDF ;
40 S (MPIOUT,MPIMCNT)=""
41 S HL("ECH")="^~\&"
42 S HL("FS")="|"
43 D INIT^HLFNC2("MPIF ICN-Q02 SERVER",.HL)
44 I $O(HL("")) D EXC^RGHLLOG(220,"INIT^HLFNC2 call error returned") S STOP="" Q
45 D CREATE^HLTF(.MPIMCNT,.MPIMTX,.HLDT,.HLDT1)
46 Q
47LOOP ;
48 S (MPICNT,MPIDNUM)=1
49 D MAKE
50 Q
51SEND ;ready to send
52 D GENERATE^HLMA("MPIF ICN-Q02 SERVER","GB",1,.MPIMTX,.MPIEROR,.MPIMORE)
53 I +MPIEROR=0 D EXC^RGHLLOG(220,"GENERATE^HLMA call returned error") Q
54 K %,MPIMTX,MPIEROR,MPIMORE
55 K ^TMP("HLS",$J)
56 Q
57MAKE ;
58 N LOCAL,MPIIT,TICN,STOP,X,Y,%,%H,%I,TODAY,SITE,XX,SDT,NDT
59 S LOCAL="",MPIIT=0,MPIFRES="",SITE=$P($$SITE^VASITE(),"^",3)
60 D NOW^%DTC S TODAY=X
61 ;local ICNs
62 F S MPIIT=$O(^DPT("AICNL",1,MPIIT)) Q:MPIIT="" D
63 .; LINE BELOW ADDED FOR PATCH 26 TO CLEANUP AICNL X-REF WHEN LEFT AROUND
64 .I $E($$GETICN^MPIF001(MPIIT),1,3)'=SITE S XX=$$SETLOC^MPIF001(MPIIT,0) K ^DPT("AICNL",1,MPIIT) Q
65 .;Q:+$G(^DPT("AICNL",1,MPIIT))=1 **39 changing check
66 .Q:+$G(^DPT("AICNL",1,MPIIT))=2&($P($G(^DPT("AICNL",1,MPIIT)),"^",2)=TODAY)
67 .; ^ check if A28 failed to get ICN back and should now be sent up
68 .; DON'T send if is the 2^today **35
69 .S SDT=$P($G(^DPT("AICNL",1,MPIIT)),"^",2)
70 .N X1,X2 K X S X1=SDT,X2=2 D C^%DTC S NDT=X ;**39 FIGURE 2 DAYS FROM NOW
71 .Q:+$G(^DPT("AICNL",1,MPIIT))=1&(SDT=TODAY)
72 .; **39 ^ if send up today don't send again
73 .Q:+$G(^DPT("AICNL",1,MPIIT))=1&(NDT>TODAY)
74 .;**39 ^ only send patient to MPI for Local ICN resolution 1 time UNLESS its day 3 since it was sent
75 .;I $D(^RGHL7(991.1,"ADFN",218,MPIIT)) S ^DPT("AICNL",1,MPIIT)="1^"_TODAY Q
76 .; ^ checking if potential match exception **43 REMOVE CHECK ON POTENTIAL MATCH EXCEPTIONS
77 .D MAKE3
78 ;missing ICNs
79 S MPIIT=0
80 F S MPIIT=$O(^DPT("AMPIMIS",MPIIT)) Q:MPIIT="" D
81 .K STOP
82 .I $D(^DPT(MPIIT,-9)) K ^DPT("AMPIMIS",MPIIT) Q ;**43 CHECK IF MERGED PATIENT AND CLEANUP CROSS REFERENCE
83 .S TICN=+$$GETICN^MPIF001(MPIIT)
84 .I TICN<0 L +^DPT(MPIIT):5 I '$T Q ;**35
85 .L -^DPT(MPIIT,0) ;**35
86 .;**35 If don't have ICN yet, try to lock if can't get lock skip record - still creating patient.
87 .I TICN<0,'$D(STOP) D MAKE3
88 .I TICN>0 K ^DPT("AMPIMIS",MPIIT)
89 Q
90MAKE3 ;
91 K MPIOUT
92 S MPIFRES=""
93 S:$G(MPIQRYNM)="" MPIQRYNM="EXACT_MATCH_QUERY" ;**43 changed MPIQRYNM from VTQ_PID_ICN_LOAD_1 to stop automatic add pts on the MPI
94 D VTQ1^MPIFVTQ(MPIIT,.MPIOUT,.HL,.MPIQRYNM)
95 I $P(MPIOUT(0),"^")<0,$P(MPIOUT(0),"^",2)="invalid DFN"!($P(MPIOUT(0),"^",2)="no encoding characters") D EXC^RGHLLOG(206,"DFN = "_MPIIT_" Problem with building VTQ was "_$P(MPIOUT(0),"^",2),MPIIT) Q
96 ;I $P(MPIOUT(0),"^")<0,$P(MPIOUT(0),"^",2)="Missing Required Field(s)" Q
97 ;Q:$P(MPIOUT(0),"^")<0
98 S ^DPT("AICNL",1,MPIIT)="1^"_TODAY
99 ; ^ mark Local ICN as having been sent to MPI for resolution
100 ;call for HL7 header
101 S MPIMIDT=MPIMCNT_"-"_MPIDNUM
102 D MSH^HLFNC2(.HL,MPIMIDT,.MPIMSH)
103 S MPIOUT(1)=MPIMSH
104 S ^TMP("HLS",$J,MPICNT)=MPIOUT(1)
105 S MPICNT=MPICNT+1
106 ;MESSAGE BUILT
107 S MPISEQ=0
108 ;setup VTQ segment in HL array
109 S ^TMP("HLS",$J,MPICNT)=MPIOUT(2)
110 S MPICNT=MPICNT+1
111 ;setup RDF segment in HL array
112 S ^TMP("HLS",$J,MPICNT)=MPIOUT(3)
113 ;loop through and add the additional RDF continuations
114 N SCNT,Y S Y=3,SCNT=1 F S Y=$O(MPIOUT(Y)) Q:'Y D
115 .S ^TMP("HLS",$J,MPICNT,SCNT)=MPIOUT(Y),SCNT=SCNT+1
116 S MPICNT=MPICNT+1
117 S MPIDNUM=MPIDNUM+1
118 I MPIDNUM>100 D
119 .D SEND
120 .S (MPICNT,MPIDNUM)=1
121 .D HLRDF
122 Q
Note: See TracBrowser for help on using the repository browser.