source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFA31B.m@ 1720

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1MPIFA31B ;BP/CMC-BUILD A31 MSGS ;FEB 5, 2002
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27,28,31,25,44,46**;30 Apr 99;Build 5
3 ;
4 ; Integration Agreements Utilized:
5 ; START, EXC, STOP^RGHLLOG - #2796
6 ; BLDEVN, BLDPD1, BLDPID^VAFCQRY - #3630
7 ; $$PV1^VAFCSB, $$RADE^VAFCSB, $$LABE^VAFCSB, $$PHARA^VAFCSB, $$PV2^VAFCSB - #4921
8TA31 ; Tasked entry point
9 N TMP
10 S TMP=$$A31(DFN)
11 Q
12 ;
13A31(DFN) ;BUILD AND SEND A31
14 I $P($$SITE^VASITE,"^",3)=200 Q 1
15 ; ^ PATCH 25 IF this is the FHIE Host system, don't build A31 messages
16 N RESLT,CNT,MPI,EVN,TCNT,ERR,PD1,PID,EN,LAB,PV1,PV2,RAD,PRE,ZPD
17 K HLA("HLA"),HLA("HLS")
18 Q:$E($$GETICN^MPIF001(DFN),1,3)=$P($$SITE^VASITE(),"^",3) 0
19 ; ^ LOCAL ICN DON'T SEND
20 Q:+$$GETICN^MPIF001(DFN)=-1 0
21 ; ^ NO ICN DON'T SEND
22 S CNT=1
23 D INIT^HLFNC2("MPIF ADT-A31 SERVER",.HL)
24 I $O(HL(""))="" Q "-1^"_$P(HL,"^",2)
25 S HLECH=HL("ECH"),HLFS=HL("FS"),COMP=$E(HL("ECH"),1),REP=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
26 S ERR="",TCNT=0
27 D BLDEVN^VAFCQRY(DFN,"1,2",.EVN,.HL,"A31",.ERR)
28 Q:ERR'="" ERR
29 D BLDPID^VAFCQRY(DFN,1,"ALL",.PID,.HL,.ERR) ;**25
30 Q:ERR'="" ERR
31 D BLDPD1^VAFCQRY(DFN,"3",.PD1,.HL,.ERR) ;**44 NEW PD1 SEGMENT VALUES -- SENDING CMOR AGAIN AS WITHOUT 40 ON THE MPI SIDE THIS IS A PROBLEM.
32 ;S PD1=$$PD1^VAFCSB ;**44 NEW PD1 SEGMENT VALUES -- IMDQ DECIDED NOT TO SEND PREFERRED FACILITY 9/7/06
33 N X S X="VAFCSB" X ^%ZOSF("TEST") I $T D
34 .;**44 VAFCSB coming in with DG*5.3*707
35 .S PV1=$$PV1^VAFCSB ;**44 PV1 segment
36 .S RAD=$$RADE^VAFCSB ;**44 OBX FOR LAST RADIOLOGY EXAM
37 .S LAB=$$LABE^VAFCSB ;**44 OBX FOR LAST LAB EXAM
38 .S PRE=$$PHARA^VAFCSB ;**44 OBX FOR ACTIVE PRESCRIPTIONS
39 .S PV2=$$PV2^VAFCSB ;**44 PV2 segment
40 S ZPD=$$EN1^VAFHLZPD(DFN,"1,17,21,34") ;25 ;**44 ADDED PSEUDO SSN REASON (34), 1 and 21 TO ZPD SEGMENT
41 S EN=1
42 S HLA("HLS",EN)=EVN(1),EN=EN+1
43 S CNT=0 F S CNT=$O(PID(CNT)) Q:CNT="" D
44 .I CNT=1 S HLA("HLS",EN)=PID(CNT)
45 .I CNT>1 S HLA("HLS",EN,CNT-1)=PID(CNT)
46 S EN=EN+1
47 I $G(PD1(1))'="" S HLA("HLS",EN)=PD1(1),EN=EN+1 ;**44 only pass PD1 segment if has values -- SENDING CMOR AGAIN AS WITHOUT 40 ON MPI SIDE THIS IS A PROBLEM.
48 I $G(PV1)'="" S HLA("HLS",EN)=PV1,EN=EN+1 ;**44 only pass PV1 segment if has values
49 I $G(PV2)'="" S HLA("HLS",EN)=PV2,EN=EN+1 ;**44 only pass PV2 segment if has values
50 I $G(RAD)'="" S HLA("HLS",EN)=RAD,EN=EN+1 ;**44 only pass RADIOLOGY IN OBX segment if has values
51 I $G(LAB)'="" S HLA("HLS",EN)=LAB,EN=EN+1 ;**44 only pass LAB IN OBX segment if has values
52 I $G(PRE)'="" S HLA("HLS",EN)=PRE,EN=EN+1 ;**44 only pass PRESCRIPTION IN OBX segment if has values
53 S HLA("HLS",EN)=ZPD,EN=EN+1 ;**44 ZPD SEGMENT
54 S MPI=$$MPILINK^MPIFAPI()
55 Q:$P($G(MPI),"^")=-1 "-1^No logical link defined for the MPI"
56 S HLL("LINKS",1)="MPIF ADT-A31 CLIENT^"_MPI
57 D GENERATE^HLMA("MPIF ADT-A31 SERVER","LM",1,.MPIFRSLT,"","")
58 S RESLT=$S(+MPIFRSLT:MPIFRSLT,1:$P(MPIFRSLT,"^",3))
59 S ^XTMP("MPIFA31%"_DFN,0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^"_"MPIA31 msg to MPI for DFN "_DFN
60 I '+RESLT S ^XTMP("MPIFA31%"_DFN,"MPI",0)="A"
61 K HLA,HLL("LINKS"),COMP,REP,SUBCOMP,HLA("HLA"),HLA("HLS"),MPIFRSLT
62 ;**44 REMOVED HLEID, HLECH AND HLFS from Kill line above
63 Q RESLT
64 ;
65RES ;
66 N NXT,DFN,ERROR,CODE S CODE=""
67 F NXT=1:1 X HLNEXT Q:HLQUIT'>0 D
68 .I $E(HLNODE,1,3)="MSA" S DFN=$P($P(HLNODE,HL("FS"),7),"=",2),ERROR=$P(HLNODE,HL("FS"),4),CODE=$P(HLNODE,HL("FS"),2)
69 .I $E(HLNODE,1,3)="MSA"&(CODE="AR") D
70 ..; ERROR RETURNED IN MSA - LOG EXCEPTION
71 ..D START^RGHLLOG(HLMTIEN,"","")
72 ..;**44 check which type of exception to be logged
73 ..D EXC^RGHLLOG(234,ERROR,DFN) ;**46
74 ..D STOP^RGHLLOG(0)
75 K ^XTMP("MPIFA31%"_DFN)
76 Q
Note: See TracBrowser for help on using the repository browser.