source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGFIPM1.m@ 947

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1RGFIPM1 ;ALB/CJM-PROCESS FACILITY INTEGRATION MESSAGE ;08/27/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,9**;30 Apr 99
3 ;
4RECEIVE ;
5 ;Description: Process the Facility Integration Message
6 ;
7 ;Input:
8 ; HL7 variables must be defined
9 ;Output: none
10 ;Variables:
11 ; LEGACY - station # of legacy site
12 ; PRIMARY - station # of primary site
13 ; ICN - patient ICN from message
14 ; CHECKSUM - ICN checksum from message
15 ; CMOR - station # of CMOR
16 ; CMORIEN - ien of CMOR in Institution file
17 ; HERE - ien in Institution file of site this routine is executing on
18 ; HERE("STATION#") - station number of this site
19 ; FROM - station # of sending site
20 ; DFN - ien from the patient file
21 ; HLERR - error encountered
22 ; LCHKSUM - local checksum
23 ;
24 N CMOR,CMORIEN,LEGACY,PRIMARY,ICN,FROM,HERE,DFN,CHECKSUM,LCHKSUM
25 K HLERR
26 D
27 .I '$$PARSE(0,.LEGACY,.PRIMARY,.ICN,.CHECKSUM,.FROM,.HLERR) Q
28 .S HERE=$$SITE^VASITE(),HERE("STATION#")=$P(HERE,"^",3),HERE=+HERE
29 .S DFN=$$DFN^RGFIU(ICN)
30 .I ('DFN)!('$D(^DPT(+DFN))) D Q
31 ..S HLERR=$$ERROR("PATIENT LOOKUP BASED ON ICN FAILED",228,ICN)
32 .;
33 .S LCHKSUM=$P($$GETICN^MPIF001(DFN),"V",2)
34 .I (+CHECKSUM)'=(+LCHKSUM) D Q
35 ..;If this is a local problem notify the local site
36 ..I (+LCHKSUM)'=(+$$CHECKDG^MPIFSPC(ICN)) D
37 ...S HLERR=$$ERROR("LOCAL DATABASE HAS INCORRECT ICN CHECKSUM",1,ICN)
38 ...D EXC^RGFIU(1,$P(HLERR,"^",2),DFN)
39 ..E D
40 ...S HLERR=$$ERROR("SENT INCORRECT ICN CHECKSUM",1,ICN)
41 .;
42 .S CMORIEN=$P($$MPINODE^RGFIU(DFN),"^",3)
43 .S CMOR=$$STATNUM^RGFIU(CMORIEN)
44 .;
45 .;Notify site if there is no station number for CMOR
46 .I 'CMOR D EXC^RGFIU(221,"ERROR ENCOUNTERED WHILE PROCESSING FACILITY INTEGRATION MESSAGE",DFN)
47 .;
48 .;If this is the legacy site it does not need to process this message
49 .Q:(HERE("STATION#")=LEGACY)
50 .;
51 .;If this site is the CMOR, it should only be receiving this message
52 .;from the legacy site
53 .I (CMORIEN=HERE),(FROM'=LEGACY) D Q
54 ..S HLERR=$$ERROR("SITE INTEGRATION MSG TO CMOR NOT FROM LEGACY SITE",230,ICN)
55 .;
56 .;If this site is not the CMOR, the message must be from the CMOR
57 .I CMORIEN,HERE'=CMORIEN,FROM'=CMOR D Q
58 ..S HLERR=$$ERROR("SITE INTEGRATION MSG NOT FROM CMOR, CMOR IS "_CMOR,226,ICN)
59 .;
60 .;update database
61 .I '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY) ;local exceptins are logged by $$XCHANGE if errors are encountered
62 .;
63 .;at this point the receiving application has decided that it can accept the message. An AA will be returned to the sender.
64 .;
65 .I '$D(HLERR),$G(HL("APAT"))="AL" D ACK(FROM,.HLERR)
66 .;
67 .;if this is the CMOR, notify subscribers & MPI of the site integration
68 .I CMORIEN=HERE,'$$SEND^RGFIBM(DFN,LEGACY,PRIMARY) ;local exceptions are logged by $$SEND if errors are encountered
69 ;
70 I $D(HLERR),$G(HL("APAT"))="AL" D ACK(FROM,.HLERR)
71 D:$G(RGLOG) STOP^RGHLLOG(1)
72 Q
73 ;
74ACK(FROM,HLERR) ;
75 ;Description: Send an acknowledment
76 ;
77 ;Input:
78 ; FROM - station number of site that sent the original message
79 ; HLERR - error to be returned in format <exception code>^<error text>
80 ; HL7 variables - assumed defined
81 ;
82 N RESULT,HLA,FS,CS,HLL,TOLINK
83 S TOLINK=$$GETLINK^RGFIU($$LKUP^XUAF4(FROM))
84 S HLL("LINKS",1)="RG FACILITY INTEGRATION CLIENT^"_TOLINK
85 S FS=HL("FS"),CS=$E(HL("ECH"),1)
86 I $D(HLERR) D
87 .;return NAK
88 .S HLA("HLA",1)="MSA"_FS_"ER"_FS_HL("MID")_FS_$P($G(HLERR),";;",2)_FS_FS_FS_CS_CS_CS_$P($G(HLERR),";;")
89 E D
90 .;return ACK
91 .S HLA("HLA",1)="MSA"_FS_"AA"_FS_HL("MID")
92 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.RESULT)
93 Q
94 ;
95PARSE(SKIPMSH,LEGACY,PRIMARY,ICN,CHECKSUM,FROM,HLERR) ;
96 ;Description: Parses the message and returns parameters.
97 ;Input:
98 ; SKIPMSH - (optional) if set to 1, means that the MSH segment is
99 ; not expected to exist. This is the case when the
100 ; routing logic is called.
101 ; HL7 variables must be defined (assumed)
102 ;Output:
103 ; Function Value: 1 on success, 0 on failure
104 ; LEGACY - station # of legacy site (pass by reference)
105 ; PRIMARY - station # of primary site (pass by reference)
106 ; ICN - ICN of patient (pass by reference)
107 ; CHECKSUM - ICN checksum (pass by reference)
108 ; FROM - station # of sendign site (pass by reference)
109 ; HLERR - returns a message if an error is encountered (pass by reference)
110 ;
111 ;Variables:
112 ; FS - field seperator
113 ; CS - component seperator
114 ; ERRFLAG - initially set to 1, set to 0 if message passes all checks
115 ;
116 N FS,CS,ERRFLAG
117 S FS=HL("FS")
118 S CS=$E(HL("ECH"),1)
119 S ERRFLAG=1
120 S (LEGACY,PRIMARY,ICN,CHECKSUM,FROM)=""
121 K HLERR
122 ;
123 D
124 .D:'$G(SKIPMSH) Q:$D(HLERR)
125 ..X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("MSH") Q
126 ..I $P(HLNODE,FS)'["MSH" S HLERR=$$SEGERROR("MSH") Q
127 ..S FROM=$P($P(HLNODE,FS,4),CS)
128 ..I 'FROM S HLERR=$$ERROR("MISSING STATION NUMBER IN MSH SEGMENT FOR SENDING SITE",11) Q
129 .;
130 .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("EVN") Q
131 .I $P(HLNODE,FS)'["EVN" D Q:$D(HLERR)
132 ..I $G(SKIPMSH) X HLNEXT
133 ..I $P(HLNODE,FS)'["EVN" S HLERR=$$SEGERROR("EVN") Q
134 .I $P(HLNODE,FS,5)'=51 S HLERR=$$ERROR("EVENT REASON CODE NOT 51",9) Q
135 .;
136 .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("PID") Q
137 .I $P(HLNODE,FS)'["PID" S HLERR=$$SEGERROR("PID") Q
138 .S ICN=$P($P(HLNODE,FS,3),"V")
139 .I 'ICN D Q
140 ..S HLERR=$$ERROR("MISSING ICN IN PID SEGMENT",10)
141 .S CHECKSUM=$P($P(HLNODE,FS,3),"V",2)
142 .;
143 .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("PV1",ICN) Q
144 .I $P(HLNODE,FS)'["PV1" S HLERR=$$SEGERROR("PV1",ICN) Q
145 .;
146 .X HLNEXT I (HLQUIT'>0) S HLERR=$$SEGERROR("NTE",ICN) Q
147 .I $P(HLNODE,FS)'["NTE" S HLERR=$$SEGERROR("NTE",ICN) Q
148 .S LEGACY=$P($P(HLNODE,FS,4),CS)
149 .I 'LEGACY S HLERR=$$ERROR("MISSING LEGACY STATION # IN NTE SEGMENT",8,ICN) Q
150 .S PRIMARY=$P($P(HLNODE,FS,4),CS,2)
151 .I 'PRIMARY S HLERR=$$ERROR("MISSING PRIMARY STATION # IN NTE SEGMENT",8,ICN) Q
152 .S ERRFLAG=0
153 Q 'ERRFLAG
154 ;
155ERROR(ERRMSG,CODE,ICN) ;
156 ;Description: formats ERRMSG in format <exception type>;;<error text>
157 ;Input:
158 ; ERRMSG - text to incorporate into message
159 ; CODE - Exception Type
160 ; ICN - patient ICN
161 ;
162 ;
163 Q $G(CODE)_";;"_" From Station:"_$P($$SITE^VASITE(),"^",3)_" ICN:"_$G(ICN)_" Code:"_$G(CODE)_" Msg:"_$G(ERRMSG)
164 ;
165 ;
166SEGERROR(SEGMENT,ICN) ;
167 ;Description: formats error if expected segment not there
168 S ERRMSG="MISSING SEGMENT: "_SEGMENT
169 Q $$ERROR(ERRMSG,7,$G(ICN))
Note: See TracBrowser for help on using the repository browser.