source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASPREC4.m@ 1306

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1EASPREC4 ;ALB/PJH - PROCESS INCOMING HL7 (QRY) MESSAGES ; 11/27/07 3:04pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; CLONED FROM IVMPREC (ESR EVENT DRIVER)
6 ;
7 ; This routine will process (QRY) HL7 messages received from HEC
8 ; At present, the (QRY) message queries for updated information
9 ; for a single patient.
10 ;
11 ;
12QRY ; - Receive Query Message requesting further information
13 ;
14 S (HLEVN,IVMCT,IVMERROR,IVMFLAG)=0
15 ;
16 K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
17 S IVMRTN="IVMPREC"
18 K ^TMP($J,IVMRTN),^TMP("HLS",$J),^TMP("HLA",$J)
19 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
20 .S CNT=0
21 .S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
22 .F S CNT=$O(HLNODE(CNT)) Q:'CNT D
23 ..S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
24 ;
25 ; INITIALIZE HL7 VARIABLES
26 S HLEID="EAS ESR "_$P($$SITE^VASITE,"^",3)_" QRY-Z07 SERVER"
27 S HLEID=$O(^ORD(101,"B",HLEID,0))
28 D INIT^HLFNC2(HLEID,.HL)
29 S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
30 ;
31 ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks
32 K ^TMP($J,"CC")
33 ;
34 F IVMDA=0:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="QRD"!($E(IVMSEG,1,3)="MSH") D
35 .I $E(IVMSEG,1,3)="MSH" S IVMMSHID=$P(IVMSEG,HLFS,10),MSGID=$P(IVMSEG,HLFS,10),HLMID=MSGID Q
36 .K HLERR S IVMFLAG=1
37 .S IVMSEG=$P(IVMSEG,HLFS,2,999) ; strip off segment name
38 .S IVMQLR=$P(IVMSEG,HLFS,7),DFN=$P(IVMSEG,HLFS,8),IVMIY=$P(IVMSEG,HLFS,10)
39 .D ERRCK
40 .I $D(HLERR) D ACK
41 .I '$D(HLERR) D
42 ..N EVENTS
43 ..; - if master query - create entry in (#301.9) file
44 ..I IVMQLR>1,'DFN D Q
45 ...S IVMSEG1="QRD"_HLFS_IVMSEG
46 ...S:'$D(^IVM(301.9,1,10,0)) ^(0)="^301.9001DA^"
47 ...S DA(1)=1,DIC="^IVM(301.9,1,10,",DIC(0)=""
48 ...S X=IVMIY
49 ...K DO,DD D FILE^DICN
50 ...S DA=+Y,DA(1)=1,DIE="^IVM(301.9,1,10,"
51 ...S DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1" D ^DIE
52 ..;
53 ..; Send AE if veteran has a Pseudo SSN and eligibility is not verified
54 ..;Removed with IVM*2*105
55 ..; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q
56 ..;
57 ..; - prepare (ACK) message
58 ..D:'$D(HLERR) MSGHDR ;header (MSH)
59 ..D ACK ;message (MSA)
60 ..;
61 ..; - set up local HL7 event type code in MSH
62 ..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="QRD"_HLFS_IVMSEG ; copy of incoming QRD
63 ..;
64 ..; - build 'FULL' transmission (note: without MSH segment)
65 ..S IVMMTDT=$E(IVMIY,1,3)+1_"1231.9999"
66 ..D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)
67 ;
68 ; IVM*2.0*105 BAJ 11/02/2005
69 ; send AE if inconsistencies found.
70 I ^TMP($J,"CC",0) S HLERR="Message not sent. Inconsistencies in Record" D ACK
71 K ^TMP($J,"CC")
72 ;
73 F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
74 I 'IVMFLAG S HLERR="Invalid Message Format" D ACK
75 S HLMTN="ORF"
76 S HLMTIENA=HLMTIEN
77 K ^TMP("HLA",$J) M ^TMP("HLA",$J)=^TMP("HLS",$J) K ^TMP("HLS",$J)
78 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)
79 ;
80QRYQ K DFN,DR,HLEVN,IVMCT,IVMDA,IVMERROR,IVMFLAG,IVMIY,IVMMTDT,IVMSEG,IVMSEG1,IVMQLR,IVMMSHID,MSGID,MSHID
81 K ^TMP("HLA",$J),^TMP("HLS",$J),^TMP($J,IVMRTN)
82 Q
83 ;
84 ;
85ERRCK ; Perform error checks on HL7 (QRD) segment
86 I ('DFN!(DFN'=+DFN)) S:IVMQLR'>1 HLERR="Invalid DFN"
87 I '$D(HLERR) S IVMIY=$$FMDATE^HLFNC(IVMIY) I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) S HLERR="Invalid Income Year"
88 I '$D(HLERR),$P(IVMSEG,HLFS,2)'="R" S HLERR="Invalid Query Format Code"
89 I '$D(HLERR),$P(IVMSEG,HLFS,3)'="I",($P(IVMSEG,HLFS,3)'="D") S HLERR="Invalid Query Priority"
90 I '$D(HLERR),$P(IVMSEG,HLFS,9)'="DEM" S HLERR="Invalid Query Subject Filter"
91 I '$D(HLERR),$P(IVMSEG,HLFS,12)'="T" S HLERR="Invalid Query Results Level"
92 ;
93 Q
94 ;
95MSGHDR ; prepare header MSH segment in batch of 100 message events
96 ; input variables:
97 ; IVMCT record counter
98 ; HLEVN event number
99 ; MSHID outgoing message id
100 ; HL array for protocol
101 ;
102 N MID,HLRES
103 S HLEVN=$G(HLEVN)+1
104 D:(HLEVN#100)=1
105 .K MSHID,HLDT,HLDT1,HLMTIEN
106 .D INIT^HLFNC2(HLEID,.HL)
107 .D CREATE^HLTF(.MSHID,.HLMTIEN,.HLDT,.HLDT1)
108 S MID=MSHID_"-"_HLEVN
109 D MSH^HLFNC2(.HL,MID,.HLRES)
110 S IVMCT=$G(IVMCT)+1
111 S ^TMP("HLS",$J,IVMCT)=HLRES
112 Q
113 ;
114ACK ; prepare positive and negative acknowledgement (ACK) message
115 ; (positive acknowledgement: MSA segment with no MSH segment)
116 ; (negative acknowledgement: MSA segment with MSH segment)
117 N MID,HLRES
118 S IVMCT=$G(IVMCT)+1
119 D:$D(HLERR)
120 .S IVMERROR=1
121 .S HLEVN=HLEVN+1
122 .D:(HLEVN#100)=1
123 ..K HLMID,HLMTIEN,HLDT,HLDT1 ; set up batch
124 ..D INIT^HLFNC2(HLEID,.HL)
125 ..D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
126 .S MID=HLMID_"-"_HLEVN
127 .D MSH^HLFNC2(.HL,MID,.HLRES)
128 .S ^TMP("HLS",$J,IVMCT)=HLRES
129 .S IVMCT=IVMCT+1
130 .S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_HLERR_"- SSN "_$S($G(DFN):$P($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND")
131 I '$D(HLERR) S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AA"_HLFS_HLMID
132 ;
133 Q
134 ;
Note: See TracBrowser for help on using the repository browser.