source: FOIAVistA/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFA31I.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1MPIFA31I ;ALB/JRP-PROCESS ADT-A31 MESSAGE FROM MPI ;03-JAN-97
2 ;;1.0; MASTER PATIENT INDEX VISTA ;**1,21**;30 Apr 99
3 ;
4 ; Integration Agreements Utilized:
5 ; ^DGCN(391.91 - #2751
6 ; ^DPT("AICNL" - #2070
7 ; EXC^RGHLLOG - #2796
8 ;
9PROCESS(MSGARR) ;Process ADT-A31 message received from MPI when a new
10 ; patient is assigned an Integration Control Number
11 ;
12 ;Input : MSGARR - Array containing ADT-A31 message (full global ref)
13 ; - MSGARR must be in format compatible with interaction
14 ; with DHCP HL7 package
15 ; MSGARR(1) = First segment of message
16 ; MSGARR(1,n) = Continuation node(s) for segment
17 ; MSGARR(x) = Xth segment of message
18 ; MSGARR(x,n) = Continuation node(s) for segment
19 ; - Defaults to ^TMP("MPIFA31",$J,"MPI-ADT-A31")
20 ;Output : ICN = Successfully processed
21 ; -1^Reason = Failure
22 ;Notes : The MPI uses an ADT-A31 message to return the ICN of new
23 ; patients. This value (seq # 2 of PID segment) is the only
24 ; information that will be stored.
25 ;
26 ;Check input
27 S MSGARR=$G(MSGARR)
28 S:(MSGARR="") MSGARR="^TMP(""MPIFA31"","_$J_",""MPI-ADT-A31"")"
29 Q:(('$D(@MSGARR))!('$O(@MSGARR@(0)))) "-1^Array containing ADT-A31 message not valid"
30 ;Declare variables
31 N MSH,EVN,PID,SEND,RECEIVE,EVENT,REASON,SEGMENT,SEGNAME
32 N ICN,ICNNUM,ICNCHECK,DFNCHECK,CHKSCHM,SSN,LOCAL,TMP,FLDSEP,HLECH
33 N CMPSEP,REPSEP,ESC,SUBSEP,TMP1,TMP2
34 ;Parse required segments out of message
35 S (MSH,EVN,PID)=""
36 S TMP=0
37 F S TMP=+$O(@MSGARR@(TMP)) Q:('TMP) D
38 .;Get segment and screen out unused segments
39 .S SEGMENT=$G(@MSGARR@(TMP))
40 .S SEGNAME=$E(SEGMENT,1,3)
41 .S TMP1=","_SEGNAME_","
42 .Q:('(",MSH,EVN,PID,"[TMP1))
43 .;Use first occurrance of segment
44 .Q:(@SEGNAME'="")
45 .;Remember field separator if MSH segment
46 .S:(SEGNAME="MSH") FLDSEP=$E(SEGMENT,4)
47 .;Drop segment name and field separator for storage
48 .S @SEGNAME=$E(SEGMENT,5,$L(SEGMENT))
49 .;Account for rollover (begin rollover subscripting with 1)
50 .S TMP1=0
51 .S TMP2=1
52 .F S TMP1=+$O(@MSGARR@(TMP,TMP1)) Q:('TMP1) D
53 ..;Get/save rollover
54 ..S @SEGNAME@(TMP2)=$G(@MSGARR@(TMP,TMP1))
55 ..S TMP2=TMP2+1
56 ;Make sure used segments were all found
57 F SEGNAME="MSH","EVN","PID" Q:(@SEGNAME="")
58 Q:(@SEGNAME="") "-1^Required segment ("_SEGNAME_") missing"
59 ;Safety check on field separator (use DHCP default value)
60 S:($G(FLDSEP)="") FLDSEP="^"
61 ;Get encoding characters
62 S HLECH=$P(MSH,FLDSEP,1)
63 ;Component separator
64 S CMPSEP=$E(HLECH,1)
65 ;Repetion separator
66 S REPSEP=$E(HLECH,2)
67 ;Escape character
68 S ESC=$E(HLECH,3)
69 ;Subcomponent separator
70 S SUBSEP=$E(HLECH,4)
71 ;Process MSH segment
72 ; - Get sending facility
73 S SEND=$P(MSH,FLDSEP,3)
74 ; - Get receiving facility
75 S RECEIVE=$P(MSH,FLDSEP,5)
76 ; - Get event type
77 S EVENT=$P($P(MSH,FLDSEP,8),CMPSEP,2)
78 ; - Validate information in MSH segment
79 ; - MPI is sending facility
80 ;Q:(SEND'="200M") "-1^Sending facility not valid (must be '200M')"
81 ; - Receiving facility is local facility
82 S TMP=+$P($$SITE^VASITE(),"^",3)
83 Q:(RECEIVE'=TMP) "-1^Receiving facility not valid (must be "_TMP_")"
84 ; - Event type is A31
85 Q:(EVENT'="A31") "-1^Event type not valid (must be 'A31')"
86 ;Process EVN segment
87 ; - Get event reason
88 S REASON=$P(EVN,FLDSEP,4)
89 ; - Validate information in EVN segment
90 ; - Event reason is 95
91 Q:(REASON'="95") "-1^Event reason code not valid (must be '95')"
92 ;Process PID segment
93 ; - Get ICN & checksum & checksum scheme
94 S TMP=$P(PID,FLDSEP,2)
95 S ICN=$P(TMP,CMPSEP,1)
96 Q:(ICN'?1.16N1"V"6N) "-1^ICN not in correct format"
97 S ICNNUM=$P(ICN,"V",1)
98 S ICNCHECK=$P(TMP,"V",2)
99 Q:((ICNNUM="")!(ICNCHECK="")) "-1^Could not determine ICN"
100 ; - Validate checksum
101 Q:(ICNCHECK'=$$CHECKDG^MPIFSPC(ICNNUM)) "-1^ICN/checksum not valid"
102 ; - Get DFN & checksum & checksum scheme
103 S TMP=$P(PID,FLDSEP,3)
104 ; - Get SSN (account for roll over)
105 S SSN=""
106 S TMP=$L(PID,FLDSEP)
107 S TMP1=$P(PID,FLDSEP,TMP)
108 S:(TMP=19) SSN=$P(PID,FLDSEP,19)_$P($G(PID(1)),FLDSEP,1)
109 S:(TMP>19) SSN=$P(PID,FLDSEP,19)
110 S:(TMP<19) SSN=$P($G(PID(1)),FLDSEP,((19-TMP)+1))
111 ; - Validate information in PID
112 ; - Make sure DFN exists
113 S LOCAL=$G(^DPT(DFN,0))
114 Q:($P(LOCAL,"^",1)="") "-1^Could not locate patient (bad DFN)"
115 ; - Make sure SSNs match
116 Q:($P(LOCAL,"^",9)'=SSN) "-1^DFN/SSN pairing not valid"
117 ;Extra validation checks
118 ; - Verify lack of national ICN
119 I ($$GETICN^MPIF001(DFN)>0) Q:('$D(^DPT("AICNL",1,DFN))) "-1^National ICN already assigned to patient"
120 ;Passed all validation checks - store ICN & checksum
121 S TMP=$$SETICN^MPIF001(DFN,ICNNUM,ICNCHECK)
122 Q:(TMP<0) "-1^Unable to store ICN and checksum"
123 ;Delete local ICN flag
124 S TMP=$$SETLOC^MPIF001(DFN,0)
125 S TMP=$$CHANGE^MPIF001(DFN,+$$SITE^VASITE)
126 N HERE,TFSITE
127 S HERE=+$P($$SITE^VASITE,"^",3)
128 S TFSITE=$$LKUP^XUAF4(HERE)
129 Q:+TFSITE'>0 ICN
130 Q:$D(^DGCN(391.91,"APAT",DFN,TFSITE)) ICN
131 K DD,DO N DIC,X,Y
132 S DIC="^DGCN(391.91,",DIC("DR")=".02///`"_TFSITE,X=DFN,DIC(0)="LQZ"
133 D FILE^DICN
134 I +Y=-1 S ^XTMP($J,"MPIF","MSHERR")="Treating Facility Add Failed" D
135 .D EXC^RGHLLOG(212,"DFN= "_DFN_" Treating Facility= "_TFSITE,DFN)
136 K DD,DO,DIC,X,Y
137 ;Done
138 Q ICN
Note: See TracBrowser for help on using the repository browser.