source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFA24.m@ 1604

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1MPIFA24 ;BPOFO/CMC-A24 PROCESSING ROUTINE ;18 Mar 02
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27,31,25,41,39,48**;30 Apr 99;Build 6
3 ;
4 ; Integration Agreements Utilized:
5 ; START, EXC, STOP^RGHLLOG - #2796
6 ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
7 ; ^DPT("AICN" - #2070
8 ; DELETETF^VAFCTFU, FILE^VAFCTFU - #2988
9 ;
10 ;PROCESS A24 RESULTING FROM A28 ADD TO MPI MESSAGE OR FROM A40 MERGE
11A24 ;
12 N MPII,MPIJ,ARRY,SEG,CNT,ERR,SITE,MSG,DFN,IEN,LIST,RARRY
13 S (CNT,ERR,FIRST)=1
14 F MPII=1:1 X HLNEXT Q:HLQUIT'>0 S MSG=HLNODE D
15 .S MPIJ=0 F S MPIJ=$O(HLNODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=HLNODE(MPIJ)
16 .S SEG=$E(HLNODE,1,3)
17 .I SEG="MSH" D MSH(.ARRY,.MSG) Q
18 .I SEG="EVN" D EVN(.ARRY,.MSG) Q
19 .I SEG="PID" D PID(.ARRY,.MSG,FIRST) D:FIRST=1 S FIRST=2 Q
20 ..;preserve the retained ICN values 991.01 and 991.02
21 .. S RARRY(991.01)=ARRY(991.01),RARRY(991.02)=ARRY(991.02)
22 .I SEG="PD1" D PD1(.ARRY,.MSG) Q
23 ;
24 ;restore the retained ICN values
25 S ARRY(991.01)=RARRY(991.01),ARRY(991.02)=RARRY(991.02)
26 ;UPDATE 991.01, 991.02, 991.03
27 ;**41 first check for DFN, if this DFN location is here
28 I $G(ARRY("DFN",2))'=""&($G(ARRY("DFNLOC"))=$P($$SITE^VASITE,"^",3)) S DFN=ARRY("DFN",2)
29 ;**41 if dfn is not passed set DFN from ICN
30 I $G(DFN)="" D
31 . I $G(ARRY("ICN",2))'="" S DFN=$$GETDFN^MPIF001(ARRY("ICN",2))
32 . I $G(ARRY("ICN",2))=""!(+$G(DFN)'>0) D
33 .. I $G(ARRY("DFN",2))'="" S DFN=ARRY("DFN",2)
34 .. I $G(ARRY("DFN",2))="" S DFN=ARRY("DFN",1)
35 S ARRY(991.03)=$$LKUP^XUAF4(ARRY(991.03))
36 I +$G(DFN)'>0 S ERR="-1^Unknown Identifier(s) ICN#"_$G(ARRY("ICN",2))_" and DFN#"_$G(ARRY("DFN",2))
37 I +$G(DFN)>0 S ERR=$$UPDATE^MPIFAPI(DFN,"ARRY",0) D
38 .;remove ALL Treating Facilities except your sites and add the CMOR
39 .D TFL^VAFCTFU1(.LIST,DFN) I $O(LIST(0)) D
40 .. N LOC,MPINODE,LOCIEN,CMOR,MPIFX,ERROR
41 .. S (CMOR,MPIFX)=0 F S MPIFX=$O(LIST(MPIFX)) Q:'MPIFX I $P(LIST(MPIFX),"^",5)="VAMC" D
42 ... ;get MPI node
43 ... S MPINODE=$$MPINODE^MPIFAPI(DFN),LOC=$P(LIST(MPIFX),"^"),LOCIEN=$$IEN^XUAF4(LOC)
44 ... I LOC=$P($$SITE^VASITE,"^",3) Q ;do not delete own site
45 ... I LOCIEN=$P(MPINODE,"^",3) S CMOR=LOCIEN Q ;do not delete CMOR site
46 ... S ERROR=$$DELETETF^VAFCTFU($P(MPINODE,"^",1),LOCIEN)
47 .. ;add CMOR site to TF list if it did not already exist
48 .. I CMOR'=0 D FILE^VAFCTFU(DFN,CMOR,1)
49 .; trigger A31 to MPI incase there have been edits since the ICN was created -- tasked off
50 .; **39 DON'T TASK OFF A31 IF MOVING FROM ONE NATIONAL ICN TO A DIFFERENT NATIONAL ICN
51 .I ARRY("ICN",1)=ARRY("ICN",2) D
52 ..S ZTRTN="TA31^MPIFA31B",ZTDESC="A31 triggered from A24 for DFN "_DFN ;**39 added DFN to text
53 ..S ZTSAVE("DFN")=DFN,ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
54 ..D ^%ZTLOAD
55 .I ARRY("ICN",1)'=ARRY("ICN",2) D RESEX^MPIFDUP(DFN,2) ;**48
56 .K ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTREQ
57 ;
58 S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_$S(+$G(ERR)'>0:$P(ERR,"^",2),1:"")
59 S $P(HLA("HLA",1),HL("FS"),7)="ICN="_ARRY("ICN",1)
60 D LINK^HLUTIL3(ARRY("SITE"),.LINK) S IEN=$O(LINK(0)),HLL("LINKS",1)="^"_LINK(IEN)
61 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MPIFRSLT,"",.HL)
62 K LINK,MPIFRSLT
63 ;PATCH 25
64 I ARRY("ICN",1)'=ARRY("ICN",2),ARRY("ICN",2)'="" D
65 .; ^ checking if this is a result of a "merge" of ICNs from the MPI
66 .; to trigger if this is station 200 the MERGE for the FHIE Framework
67 .Q:$P($$SITE^VASITE,"^",3)'=200
68 .N FHIE S FHIE=$$MERGE^OMGPIDMI(ARRY("ICN",2),ARRY("ICN",1))
69 .; ^^ THIS API IS ONLY AVAILABLE ON THE FHIE HOST SYSTEM
70 .I +FHIE=-1 D START^RGHLLOG(),EXC^RGHLLOG(208,$P(FHIE,"^",2),DFN),STOP^RGHLLOG()
71 Q
72 ;
73MSH(ARY,MSG) ;processing MSH fields
74 N COMP
75 S COMP=$E(HL("ECH"),1)
76 S ARY("SITE")=$$LKUP^XUAF4($P($P(MSG,HL("FS"),4),COMP))
77 Q
78 ;
79EVN(ARY,MSG) ;processing EVN fields
80 S ARY("EVTR")=$P(MSG,HL("FS"),2) ;not currently used
81 S ARY("DLT")=$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
82 Q
83 ;
84PID(ARY,MSG,FIRST) ;processing PID fields
85 N REP,PID,COMP,SUBCOMP,MPIDFN,MPISSN,ICN
86 S REP=$E(HL("ECH"),2),COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
87 S MPISSN="",MPIDFN=""
88 ;**41 replaced with line below D PIDPROC^MPIFA43(.ICN,.MPISSN,.MPIDFN,.PID)
89 D PIDP^RGADTP1(.MSG,.ARY,.HL)
90 I FIRST=1 S ARY(991.01)=+ARY("ICN"),ARY(991.02)=$P(ARY("ICN"),"V",2)
91 S ARY("ICN",FIRST)=ARY("ICN")
92 S ARY("SSN",FIRST)=ARY("SSN")
93 S ARY("DFN",FIRST)=ARY("DFN")
94 Q
95 ;
96PD1(ARY,MSG) ;processing PD1 fields
97 N COMP
98 S COMP=$E(HL("ECH"),1)
99 S ARY(991.03)=$P($P(HLNODE,HL("FS"),4),COMP,3)
100 Q
101 ;
102PROC ;
103 N NXT,DFN
104 F NXT=1:1 X HLNEXT Q:HLQUIT'>0 D
105 .I $E(HLNODE,1,3)="MSA" S DFN=$P($P(HLNODE,HL("FS"),7),"=",2)
106 .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,HL("FS"),4)'="") D
107 ..; ERROR RETURNED IN MSA - LOG EXCEPTION
108 ..D START^RGHLLOG(HLMTIEN,"","")
109 ..D EXC^RGHLLOG(208,$P(HLNODE,HL("FS"),4)_" for HL msg# "_HLMTIEN,DFN)
110 ..D STOP^RGHLLOG(0)
111 K ^XTMP("MPIFA24%"_DFN)
112 Q
Note: See TracBrowser for help on using the repository browser.