source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPREC.m@ 1046

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

initial load of WorldVistAEHR

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