source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFA43.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1MPIFA43 ;BIR/DLR-Utility for processing an ADT-A43 Un-link ID ;MAR 18, 2002
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**22,41,46**;30 Apr 99;Build 5
3DBIA ; Supported IA's
4 ;
5 ;IA: 2796 - EXC, START, and STOP^RGHLLOG
6 ;IA: 2988 - $$DELALLTF and $$DELETETF^VAFCTFU
7 ;IA: 3767 - PIDP^RGADTP1
8 ;
9IN ;Entry point for processing ADT-A43 - Move patient information
10 ;Called from the MPIF ADT-A43 CLIENT protocol processing routine
11 ;There are no inputs or outputs
12 ;
13 N MPIF,STATN,MPIFI,MSG,SG,MPIFARR,PDFN,INST,MFUPT,PDLT,TFIEN,ICNAUTH,MPISITE,MRG
14 N ICN,HLCOMP,CNT,X,MPIFERR,MPIFX,MPIDFN,MPISSN,ERROR,DFN,NODE,CMOR2,PID,ARRAY
15 S MPISSN="",MPIDFN="",ICN="",ERROR=""
16INIT ;Process in the ADT-A43 Move Patient Identifier msg
17 F MPII=1:1 X HLNEXT Q:HLQUIT'>0 S MSG=HLNODE D
18 .S MPIJ=0 F S MPIJ=$O(HLNODE(MPIJ)) Q:'MPIJ S MSG(MPIJ)=HLNODE(MPIJ)
19 .S SG=$E(HLNODE,1,3),MPIF(MPII)=HLNODE D:SG?2A1(1A,1N) PICK
20 .;**45 ABOVE TO REPLACE COMMENTED LINE BELOW
21 ;F MPIFI=1:1 X HLNEXT Q:HLQUIT'>0 S (MSG,MPIF(MPIFI))=HLNODE,SG=$E(HLNODE,1,3) D:SG?2A1(1A,1N) PICK
22 D MOVE(.ARRAY,.ERROR)
23 ;create response message
24 S CNT=1
25 S HLA("HLA",1)="MSA"_HL("FS")_$S($G(ERROR)=0:"AA",1:"AE")_HL("FS")_HL("MID")_HL("FS")_$S($G(ERROR)=0:"",1:$P(ERROR,"^",2)) S CNT=CNT+1
26 D ROUTE
27 ;Send back the appl. ack (ACK) with the ADT-A43 transaction status
28 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MPIFERR,"",.HLP)
29 Q
30PICK ;check routine for segment entry point
31 I $T(@SG)]"" D @SG
32 I $T(@SG)="" Q
33 Q
34MSH ;;MSH
35 ;process the MSH segment
36 S (HLFS,HL("FS"))=$E(MSG,4),(HLECH,HL("ECH"))=$E(MSG,5,8)
37 S HLCOMP=$E(HL("ECH"),1)
38 S MPIFARR("SENDING SITE")=$P(MSG,HL("FS"),4)
39 Q
40EVN ;;EVN
41 ;process the EVN segment
42 S STATN=+$$SITE^VASITE()_"^"_$$FMDATE^HLFNC($P(MSG,HL("FS"),3))
43 Q
44PID ;;PID
45 ;process the PID segment
46 N COMP,REP,SUBCOMP,AUTH,IDTYP,LOC,AUTHTYP,MPIJ
47 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)
48 S MPIJ=$P(MSG,HL("FS"),2)
49 D PIDP^RGADTP1(.MSG,.ARRAY,.HL)
50 ;ARRAY("ICN") = NEW ICN and ARRAY("DFN") = mismatched record to be corrected
51 Q
52PD1 ;processing PD1 fields for new CMOR
53 N COMP
54 S COMP=$E(HL("ECH"),1)
55 S ARRAY("CMOR")=$P($P(HLNODE,HL("FS"),4),COMP,3)
56 Q
57MRG ;
58 N COMP,REP,SUBCOMP,AUTH,IDTYP,LOC,AUTHTYP,FID,ID
59 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4),REP=$E(HL("ECH"),2)
60 N MPIFX,ID,AUTH
61 S FID=$P(MSG,HL("FS"),2)
62 F MPIFX=1:1:$L(FID,REP)+1 S ID=$P(FID,REP,MPIFX),PID=$P(ID,COMP),AUTH=$P($P(ID,COMP,4),SUBCOMP),AUTHTYP=$P($P(ID,COMP,4),SUBCOMP,2),IDTYP=$P(ID,COMP,5),LOC=$P($P(ID,COMP,6),SUBCOMP,2) D
63 . I AUTH="USSSA" S MPISSN=PID
64 . ;capture the old or mismatched ICN in ARRAY("ICNMISMATCH")
65 . I AUTH="USVHA" I IDTYP="NI" S (ARRAY("ICNMISMATCH"),ICN)=PID S ARRAY("ICNMISMATCHLOC")=LOC
66 . I AUTH="USVHA" I IDTYP="PI" S MPIDFN=PID S ARRAY("DFNLOC")=LOC
67 Q
68RSP ;response process logic entry point
69 Q
70ROUTE ;routing logic entry point
71 N MPI S MPI=$$MPILINK^MPIFAPI() D
72 .I $P($G(MPI),U)'=-1 S HLL("LINKS",1)="MPIF ADT-A43 CLIENT"_"^"_MPI
73 .I $P($G(MPI),U)=-1 D
74 ..N RGLOG D START^RGHLLOG(HLMTIEN,"","")
75 ..D EXC^RGHLLOG(224,"No MPI link identified ",$G(PDFN))
76 ..D STOP^RGHLLOG(0)
77 Q
78MOVE(ARRAY,ERROR) ;
79 ;replace ARRAY("ICNMISMATCHED") with ARRAY("ICN")
80 N MPIARR
81 S ERROR=0
82 ;I ARRAY("DFNLOC")="" OLD MESSAGING SO USE ARRAY("ICNMISMATCHLOC")
83 I $G(ARRAY("DFNLOC"))="" S ARRAY("DFNLOC")=ARRAY("ICNMISMATCHLOC")
84 I $G(ARRAY("CMOR"))="" S ARRAY("CMOR")=ARRAY("DFNLOC")
85 ;if assigning authority'= site station# then Quit because this is not the mismatched site so MFN-M05 sent as a result of site removal on MPI will remove it from all sites TF list
86 I ARRAY("DFNLOC")'=$P($$SITE^VASITE,"^",3) D Q
87 .;if assigning authority '= site station# then remove assigning authority from TF list for the given ICN
88 .N MPISITE S MPISITE=$$IEN^XUAF4(ARRAY("DFNLOC"))
89 . I ARRAY("DFNLOC")'>0 S ERROR="-1^Unable to remove station#"_ARRAY("DFNLOC")_" from TF list" Q
90 . I +ARRAY("DFNLOC")>0 S ERROR=$$DELETETF^VAFCTFU(+ARRAY("ICNMISMATCH"),MPISITE)
91 ;delete all TF's for this mismatched record
92 S ERROR=$$DELALLTF^VAFCTFU(ARRAY("ICNMISMATCH"))
93 ;if ARRAY("DFN")="" assume this is old message format and use ARRAY("ICNMISMATCHED") to get the DFN that was mismatched
94 I $G(ARRAY("DFN"))="" D Q
95 . S ARRAY("DFN")=$$GETDFN^MPIF001(ARRAY("ICNMISMATCH")) I +ARRAY("DFN")'>0 S ERROR="-1^Unable to break ICN "_ARRAY("ICNMISMATCH")_" because that ICN is unknown"
96 . Q:+$G(ERROR)=-1
97 . S MPIARR(991.01)="@",MPIARR(991.02)="@",MPIARR(991.03)="@",MPIARR(991.05)="@",MPIARR(992)=$P(ARRAY("ICNMISMATCH"),"V"),MPIARR(993)=$P($$SITE^VASITE,"^")
98 . S ERROR=$$UPDATE^MPIFAPI(ARRAY("DFN"),"MPIARR",1)
99 ;if new messaging
100 I ARRAY("ICN")'="""" D
101 . ;delete the entry first to prevent the ICN from going into history
102 . S MPIARR(991.01)="@",MPIARR(991.02)="@",MPIARR(991.03)="@",MPIARR(991.05)="@",MPIARR(992)=$P(ARRAY("ICNMISMATCH"),"V"),MPIARR(993)=$P($$SITE^VASITE,"^")
103 . S ERROR=$$UPDATE^MPIFAPI(ARRAY("DFN"),"MPIARR",1)
104 . ;update the record with the new ICN
105 . S MPIARR(991.01)=$P(ARRAY("ICN"),"V"),MPIARR(991.02)=$P(ARRAY("ICN"),"V",2),MPIARR(991.03)=$$IEN^XUAF4(ARRAY("CMOR")),MPIARR(991.05)="@",MPIARR(992)=$P(ARRAY("ICNMISMATCH"),"V"),MPIARR(993)=$P($$SITE^VASITE,"^")
106 ;move the mismatched record from ARRAY("ICNMISMATCH") to ARRAY("ICN")
107 S ERROR=$$UPDATE^MPIFAPI(ARRAY("DFN"),"MPIARR",1)
108 ;add LOCAL site to TF, if CMOR is different it will be auto added
109 D FILE^VAFCTFU(ARRAY("DFN"),+$$SITE^VASITE,1)
110 Q
Note: See TracBrowser for help on using the repository browser.