source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFBT2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1MPIFBT2 ;SLC/ARS-BATCH RESPONSE FROM MPI ;FEB 4, 1997
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,3,10,17,21,31,43**;30 Apr 99
3 ;
4 ; Integration Agreements Utilized:
5 ; ^DGCN(391.91 - #2751
6 ; EXC, START, STOP ^RGHLLOG - #2796
7 ; XMITFLAG^VAFCDD01 - #3493
8 ; $$PIVNW^VAFHPIVT - #3494
9 ;
10ADDPAT ;Called when response from MPI is received for messages sent.
11 K ^XTMP($J,"MPIF") D NOW^%DTC S ST=%,X1=ST,X2=20 D C^%DTC
12 S STP=X,^XTMP($J,"MPIF","MPIIN",0)=STP_"^"_ST_"^"_"MPI BATCH JOB"
13 K %,X,Y,X1,X2,ST,STP N RGLOG,MPIMSG S MPIMSG=HLMTIEN
14 D START^RGHLLOG(HLMTIEN,"","ADDPAT^MPIFBT2")
15 D PREPMSG,PROCESS(MPIMSG),STOP^RGHLLOG(0)
16 K ACK1,ACK2,ACK3,ACK4,HDR,MPICKG,MPIIN,MPIIPPF,MPIIT,MPINUM,MPIPPF,DA
17 K CNTR,COM,ENC,ESC,LOCAL,MSHDR,PATID,REP,SCOM,SEP,SITE,MPIDTH,VISTDTH,MPITMP,MPICNTR,MPIFOK,^XTMP($J,"MPIF"),DGSENFLG
18 Q
19PREPMSG ;prepare for response
20 N I,J,X F I=1:1 X HLNEXT Q:HLQUIT'>0 D
21 .S ^XTMP($J,"MPIF","MPIIN",I)=HLNODE,J=0
22 .F S J=$O(HLNODE(J)) Q:'J S ^XTMP($J,"MPIF","MPIIN",I,J)=HLNODE(J)
23 Q
24PROCESS(MPIMSG) ;Process mesage out of array
25 N HDR,MPICNTR S MPICNTR=1,HDR=^XTMP($J,"MPIF","MPIIN",1) ;check hdr here
26 D CHDR(HDR,.SEP,MPICNTR,MPIMSG)
27 Q:$D(^XTMP($J,"MPIF","MSHERR"))
28 F S MPICNTR=$O(^XTMP($J,"MPIF","MPIIN",MPICNTR)) Q:'MPICNTR D LOOPS(.MPICNTR,SEP,MPIMSG)
29 Q
30LOOPS(CNTR,SEP,MPIMSG) ;Loop in the batch
31 K ^XTMP($J,"MPIF","MSHERR") N MSHDR,ACK1,ACK2,ACK3,ACK4,ACK5,PATID,LOCAL,MPITMP,LICN
32 S MSHDR=^XTMP($J,"MPIF","MPIIN",+CNTR)
33 D CHKMSH(MSHDR,.SITE,SEP,MPIMSG)
34 Q:$D(^XTMP($J,"MPIF","MSHERR"))
35 S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
36 S ACK1=^XTMP($J,"MPIF","MPIIN",CNTR)
37 I $P(ACK1,SEP)'="MSA" S ^XTMP($J,"MPIF","MSHERR")="NOT AN MSA SEGMENT" D EXC^RGHLLOG(203,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
38 Q:$D(^XTMP($J,"MPIF","MSHERR"))
39 I ACK1["AR" S ^XTMP($J,"MPIF","MSHERR")="APP REJECT ERROR" D EXC^RGHLLOG(207,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
40 Q:$D(^XTMP($J,"MPIF","MSHERR"))
41 I ACK1["AE" S ^XTMP($J,"MPIF","MSHERR")="APP ERROR" D EXC^RGHLLOG(208,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
42 ;ACK1 must be an AA
43 Q:$D(^XTMP($J,"MPIF","MSHERR"))
44 S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
45 S ACK2=^XTMP($J,"MPIF","MPIIN",CNTR)
46 I $P(ACK2,SEP)'="QAK" S ^XTMP($J,"MPIF","MSHERR")="NOT A QAK SEGMENT" D EXC^RGHLLOG(202,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".")
47 Q:$D(^XTMP($J,"MPIF","MSHERR"))
48 I ACK2["NO DATA" D
49 .S ^XTMP($J,"MPIF","MSHERR")="NO DATA in MPI "
50 .;**43 NO DATA FOUND TRIGGER ADD
51 .S MPIFRPC=1 D A28^MPIFQ3($P(ACK2,SEP,2)) K MPIFRPC
52 .I ACK2["POTENTIAL MATCHES" D EXC^RGHLLOG(218,"Potential matches found, please review via MPI/PD Exception Handler",$P(ACK2,SEP,2))
53 .;.;D EXC^RGHLLOG(218,"For Patient DFN="_$P(ACK2,SEP,2)_". Use Single Patient Initialization to MPI option to manually process.",$P(ACK2,SEP,2))
54 .;I $D(^DPT($P(ACK2,SEP,2),0)) S LICN=$$ICNLC^MPIF001($P(ACK2,SEP,2))
55 .; ^ create a local ICN
56 .;I ACK2'["POTENTIAL MATCHES" D
57 .;D EXC^RGHLLOG(209,"For Patient DFN="_$P(ACK2,SEP,2)_". Need required fields before patient can be processed again the MPI.",$P(ACK2,SEP,2))
58 .;I $D(^DPT($P(ACK2,SEP,2),0)) S LICN=$$ICNLC^MPIF001($P(ACK2,SEP,2))
59 .; ^ create a local ICN
60 .N TACK,TCNTR S TCNTR=CNTR,CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)),TACK=^XTMP($J,"MPIF","MPIIN",CNTR)
61 .I $P(TACK,SEP)="MSH" S CNTR=TCNTR
62 Q:$D(^XTMP($J,"MPIF","MSHERR"))
63 S PATID=$P(ACK2,SEP,2),LOCAL=$G(^DPT(PATID,0)) ;Verify patient is in database
64 I LOCAL']"" S ^XTMP($J,"MPIF","MSHERR")="PATIENT DFN NOT IN DATABASE- BAD " D EXC^RGHLLOG(210,"Around line number "_(CNTR*2)_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
65 S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
66 ; **43 MOVED CNTR INCREASE TO GET TO NEXT MSH
67 Q:$D(^XTMP($J,"MPIF","MSHERR"))
68 S ACK3=^XTMP($J,"MPIF","MPIIN",CNTR) ;RDF DEFINITION SEGMENT NO-OP
69 I $P(ACK3,SEP)'="RDF" S ^XTMP($J,"MPIF","MSHERR")="NOT RDF SEGMENT" D EXC^RGHLLOG(204,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".",PATID)
70 Q:$D(^XTMP($J,"MPIF","MSHERR"))
71 S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:CNTR'>0
72 S RDTSEQ=1
73 S ACK4(RDTSEQ)=^XTMP($J,"MPIF","MPIIN",CNTR)
74 I $P(ACK4(RDTSEQ),SEP)'="RDT" S ^XTMP($J,"MPIF","MSHERR")="NOT RDT SEGMENT" D EXC^RGHLLOG(205,"Around line number "_(CNTR*2)_" of message "_MPIMSG_".",PATID)
75 ;
76 N RDTSQ S RDTSQ=0
77 F S RDTSQ=$O(^XTMP($J,"MPIF","MPIIN",CNTR,RDTSQ)) Q:'RDTSQ D
78 .S ACK4(RDTSEQ+1)=^XTMP($J,"MPIF","MPIIN",CNTR,RDTSQ),RDTSEQ=RDTSEQ+1
79 Q:$D(^XTMP($J,"MPIF","MSHERR"))
80 S MPITMP=$O(^XTMP($J,"MPIF","MPIIN",CNTR))
81 I MPITMP'>0 S:$E($G(^XTMP($J,"MPIF","MPIIN",MPITMP)),1,3)="BTS" CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR))
82 Q:CNTR'>0
83 D VFYRDT^MPIFBT3(.ACK4,SEP,CNTR,PATID,SITE,MPIMSG)
84 S MPITMP=$O(^XTMP($J,"MPIF","MPIIN",CNTR))
85 Q:MPITMP'>0
86 S ACK5=^XTMP($J,"MPIF","MPIIN",MPITMP)
87 I $P(ACK5,SEP)="RDT" D MULT^MPIFBT3(.CNTR,ACK5,SEP,MPIMSG,PATID)
88 K RDTSEQ
89 Q
90TFLIST(TFSITE,PATID) ;adding TFSITE site for patient to Treating Facility List (#391.91)
91 I $G(TFSITE)="" S ^XTMP($J,"MPIF","MSHERR")="Treating Facility = null" D EXC^RGHLLOG(212,"DFN = "_PATID_" Treating Facility = Null",PATID) Q
92 S TFSITE=$$LKUP^XUAF4(TFSITE)
93 Q:+TFSITE'>0
94 Q:$D(^DGCN(391.91,"APAT",PATID,TFSITE))
95 K DD,DO N DIC,X,Y L +^DGCN(391.91,0):60
96 I '$T D EXC^RGHLLOG(212,"Unable to Lock Treating Facility file to add patient DFN="_PATID_" Facility= "_TFSITE,PATID) Q
97 S DIC="^DGCN(391.91,",DIC("DR")=".02///`"_TFSITE,X=PATID,DIC(0)="LQZ"
98 I $D(^DGCN(391.91,"APAT",PATID,TFSITE)) L -^DGCN(391.91,0) Q
99 D FILE^DICN L -^DGCN(391.91,0)
100 I +Y=-1,'$D(^DGCN(391.91,"APAT",PATID,TFSITE)) S ^XTMP($J,"MPIF","MSHERR")="Treating Facility Add Failed" D EXC^RGHLLOG(212,"DFN= "_PATID_" Treating Facility= "_TFSITE_" failed when adding an entry to the Treating Facility file.",PATID)
101 K DD,DO,DIC,X,Y
102 Q
103TFUPDT(PATID,MPIMSG,CNTR) ;treating facility update message to pivot file
104 N ERR,TRANS,EVDT,X,Y,%
105 D NOW^%DTC S EVDT=% K %,X,Y
106 S ERR=$$PIVNW^VAFHPIVT(PATID,EVDT,5,PATID_";DPT(")
107 I +ERR<1 D EXC^RGHLLOG(212,"When trying to add Patient (DFN)"_PATID_" message# "_MPIMSG_" around line number "_(CNTR*2),PATID)
108 Q:+ERR<1
109 D XMITFLAG^VAFCDD01("",+ERR)
110 Q
111CHDR(HDR,SEP,CNTR,MPIMSG) ;Only process Batch message responses
112 I $P(HDR,"^")'="BHS" S ^XTMP($J,"MPIF","MSHERR")="BHS SEGMENT MISSING" D EXC^RGHLLOG(200,"for message "_MPIMSG_". The segment contains "_HDR)
113 Q:$D(^XTMP($J,"MPIF","MSHERR"))
114 S SEP=$G(HL("FS")) ;get field sep, and encoding characters
115 I SEP="" S ^XTMP($J,"MPIF","MSHERR")="Missing field seperator" D EXC^RGHLLOG(200,"Missing field seperator")
116 Q
117CHKMSH(MSHDR,SITE,SEP,MPIMSG) ;VERIFY MSH
118 I $P(MSHDR,SEP)="BTS" S ^XTMP($J,"MPIF","MSHERR")="BTS FOUND" Q
119 S:$P(MSHDR,SEP)'="MSH" ^XTMP($J,"MPIF","MSHERR")="NOT MSH HEADER MESSAGE# "_MPIMSG
120 S:$E(MSHDR,4)'=SEP ^XTMP($J,"MPIF","MSHERR")="FIELD SEPARATOR MISMATCH MESSAGE# "_MPIMSG
121 I $D(^XTMP($J,"MPIF","MSHERR")) D EXC^RGHLLOG(201,$G(^XTMP($J,"MPIF","MSHERR")))
122 Q:$D(^XTMP($J,"MPIF","MSHERR"))
123 S SITE=$P(MSHDR,SEP,6)
124 I SITE="" S ^XTMP($J,"MPIF","MSHERR")="SITE NOT IN MSH"
125 I $D(^XTMP($J,"MPIF","MSHERR")) D EXC^RGHLLOG(8,"MSH Doesn't Have SITE as 6th piece. MESSAGE# "_MPIMSG)
126 Q
Note: See TracBrowser for help on using the repository browser.