source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPTRN8.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1IVMPTRN8 ;ALB/RKS/PDJ/BRM,TDM - HL7 FULL DATA TRANSMISSION (Z07) BUILDER ; 4/10/06 4:34pm
2 ;;2.0;INCOME VERIFICATION MATCH;**9,11,19,12,21,17,24,36,37,47,48,42,34,77,76,75,79,85,89,98,56,97,104,113,109,114,105**; 21-OCT-94;Build 2
3 ;
4 ;
5BUILD(DFN,IVMMTDT,IVMCT,IVMQUERY) ; --
6 ; Description: This entry point will be used to create an HL7
7 ; "Full Data Transmission" message for a patient.
8 ;
9 ; Input:
10 ; DFN - Patient IEN
11 ; IVMMTDT - date of the patient's Means Test or Copay Test
12 ; IVMCT - count of hl7 segments transmitted, pass by reference
13 ; IVMQUERY - array passed in by reference where
14 ; IVMQUERY("LTD") -- # of the QUERY that is currently open or
15 ; undefined, zero, or null if no QUERY opened for
16 ; last treatment date
17 ; IVMQUERY("OVIS") -- # of the QUERY that is currently open or
18 ; undefined, zero, or null if no QUERY opened for
19 ; finding outpatient visits
20 ;
21 ; HL7 variables as defined by call to INIT^IVMUFNC:
22 ; HLEVN - HL7 message event counter
23 ; HLSDT - a flag that indicates that the data to be sent is
24 ; stored in the ^TMP("HLS") global array.
25 ;
26 ; The following variables returned by the INIT^HLTRANS entry point:
27 ; HLNDAP - Non-DHCP Application Pointer from file 770
28 ; HLNDAP0 - Zero node from file 770 corresponding to HLNDAP
29 ; HLDAP - DHCP Application Pointer from file 771
30 ; HLDAN - The DHCP Application Name (.01 field, file 771) for HLDAP
31 ; HLPID - HL7 processing ID from file 770
32 ; HLVER - HL7 version number from file 770
33 ; HLFS - HL7 Field Separator from the 'FS' node of file 771
34 ; HLECH - HL7 Encoding Characters from the 'EC' node of file 771
35 ; HLQ - Double quotes ("") for use in building HL7 segments
36 ; HLERR - if an error is encountered, an error message is returned
37 ; in the HLERR variable.
38 ; HLDA - the internal entry number for the entry created in
39 ; file #772.
40 ; HLDT - transmission date/time (associated with the entry in file
41 ; #772 identified by HLDA) in internal VA FileMan format.
42 ; HLDT1 - the same transmission date/time as the HLDT variable,
43 ; only in HL7 format.
44 ;
45 ; Output:
46 ; ^TMP("HLS",$J,IVMCT) - global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT variable is defined above and the IVMCT variable is a sequential number incremented by 1.
47 ;
48 ;
49 N DGINC,DGIR,DGREL,I,IVMNTE,IVMPID,IVMSUB,IVMZRD,VAFPID,VAFZEL,FBZFE,IVMZCD,DELETE,NODE,IVMPIEN,TEST,IVMPNODE,TESTTYPE,SEQS,TESTCODE,HARDSHIP,ACTVIEN,IVMZMH,IVMSEQ
50 N EDBMTZ06,ZMHSQ,SETID,OBXCNT,OBXTMP,DGSEC,SEGOCC,ZIOSEG,N101015,RF1SEG
51 ;
52 ; create (PID) Patient Identification segment
53 ; **** Add ICN to 2nd piece PID segment for MPI@HEC.
54 S IVMCMOR="1,2",IVMSEQ=1
55 ; check to see if site is a legacy site. If not add ICN to PID segment.
56 I '$D(^PPP(1020.128,"AC",$P($$SITE^VASITE,"^",3))) D
57 . I +$$GETICN^MPIF001(DFN)>0,($$IFLOCAL^MPIF001(DFN)=0) S IVMSEQ=IVMSEQ_",2",IVMCMOR="1,2,3" ;add SEQ 1 and 2 for PID
58 ;
59 ; send SSN indicating pseudo
60 ; I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1 ; strip 'P' from pseudo SSNs
61 S IVMSEQ=IVMSEQ_",3,5,7,8,11,12,13,14,19"
62 K IVMPID D BLDPID^VAFCQRY1(DFN,1,IVMSEQ,.IVMPID,.HL,.ERROR)
63 S SEGOCC=0 F S SEGOCC=$O(IVMPID(SEGOCC)) Q:SEGOCC="" D
64 . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMPID(SEGOCC)
65 ;
66 ; **** create (PD1) Patient CMOR segment for MPI@HEC.
67 S:'$D(HL("FS")) HL("FS")=HLFS
68 S:'$D(HL("ECH")) HL("ECH")=HLECH
69 S:'$D(HL("Q")) HL("Q")=HLQ
70 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLPD1(DFN,IVMCMOR)
71 ;
72 ; create (ZPD) Patient Dependent Info. segment
73 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,8,9,11,12,13,17,19,31,32,33,40"),IVMINS=$P(^(IVMCT),HLFS,12)
74 ;
75 ; create (ZTA) Temporary Address segment
76 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZTA(DFN,"1,2,3,4,5,6,7,8,9")
77 ;
78 ; create (ZIE) Ineligible segment
79 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIE(DFN,"1,2,3",1)
80 ;
81 ; create (ZEL) Eligibility segment(s)
82 ; **** Add 5th piece to ZEL to correct consistency check
83 D EN1^VAFHLZEL(DFN,"1,2,5,6,7,8,10,11,13,14,15,16,17,18,19,20,21,22,23,24,25,29,34,35,37,38,39,40",2,.VAFZEL)
84 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(1)) ; Primary Eligibility
85 I $D(VAFZEL(1,1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(1,1))
86 ; - other entitled eligibilities
87 F IVMSUB=1:0 S IVMSUB=+$O(VAFZEL(IVMSUB)) Q:'IVMSUB D
88 .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(+IVMSUB))
89 ;
90 ; create (ZEN) Enrollment segment
91 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEN(DFN)
92 ;
93 ; create (ZCD) Catastrophic Disability segment(s)
94 D BUILD^VAFHLZCD(.IVMZCD,DFN,,HLQ,HLFS)
95 F IVMSUB=0:0 S IVMSUB=+$O(IVMZCD(IVMSUB)) Q:'IVMSUB D
96 .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZCD(+IVMSUB))
97 ;
98 ; Optionally create (ZMH) Military History segments
99 D ENTER^VAFHLZMH(DFN,"IVMZMH")
100 S (ZMHSQ,SETID)=0
101 I $D(IVMZMH) F S ZMHSQ=$O(IVMZMH(ZMHSQ)) Q:ZMHSQ="" D
102 .Q:$TR($P(IVMZMH(ZMHSQ,0),HLFS,4,5),"""^~")=""
103 .S SETID=SETID+1,IVMCT=IVMCT+1
104 .S ^TMP("HLS",$J,IVMCT)="ZMH"_HLFS_SETID_HLFS_$P(IVMZMH(ZMHSQ,0),HLFS,3,6)
105 ;
106 ; create (ZRD) Rated Disabilities segment(s)
107 D EN^VAFHLZRD(DFN,"1,2,3,4",HLQ,HLFS,"IVMZRD")
108 F IVMSUB=0:0 S IVMSUB=+$O(IVMZRD(IVMSUB)) Q:'IVMSUB D
109 .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZRD(+IVMSUB,0))
110 ;
111 ; create (ZCT) Emergency Contact segment
112 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",1,1)
113 ;
114 ; create (ZEM) Employment Info. segment for (1) Patient & (2) Spouse
115 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3")
116 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3",2,2)
117 ;
118 ; create (ZGD) Guardian segment for (1) VA & (2) Civil
119 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",1)
120 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",2)
121 ;
122 ; Income Year requiring transmission from IVM Patient File (301.5)
123 S IVMIY=$S($D(IVMIY):IVMIY,1:(IVMMTDT-10000))
124 N MTINFO S MTINFO=$$FUT^DGMTU(DFN)
125 I ($E(IVMIY,1,3)+1)=$E($P(MTINFO,U,2),1,3) S IVMMTDT=$P(MTINFO,U,2)
126 ;get the primary test for the income year
127 S TESTTYPE=$$GETTYPE^IVMPTRN9(DFN,IVMMTDT,.TESTCODE,.HARDSHIP,.ACTVIEN)
128 ;
129 ; The following function call returns:
130 ; - Patient Relation IEN array in DGREL
131 ; - Individual Annual Income IEN array in DGINC
132 ; - Income Relation IEN array in DGINR
133 D ALL^DGMTU21(DFN,"VSC",IVMMTDT,"IPR",ACTVIEN)
134 ;
135 S EDBMTZ06=0 I $$VERZ06^EASPTRN1(DFN) S EDBMTZ06=1
136 ; create (ZIC) Income segment for veteran
137 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("V")),"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20")
138 I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
139 ;use IVMIY not IVMMTDT. For LTC copay exemption, IVMMTDT is not correct
140 S $P(^TMP("HLS",$J,IVMCT),"^",3)=$$HLDATE^HLFNC(IVMIY)
141 ;
142 ; create (ZIR) Income Relation segment for veteran
143 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("V")),"1,2,3,4,5,10")
144 I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^1"
145 ;
146 ; create (ZDP) Patient Dependent Info. segment for spouse
147 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZDP(+$G(DGREL("S")),"1,2,3,4,5,6,7,8,9,10")
148 I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
149 .; - pass non-existant SSNs as 0s
150 .S $P(X,HLFS,6)="000000000"
151 ;
152 ; create (ZIC) Income segment for spouse
153 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("S")),"1,2,3,4,5,6,7,8,9,10,11,12,16,17,18,19,20")
154 I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
155 ;
156 ; create (ZIR) Income Relation segment for spouse
157 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("S")),"1,2,3")
158 I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^"_$P(^TMP("HLS",$J,IVMCT),"^",2)
159 ;
160 ;
161 ; create ZDP, ZIC, and ZIR segments for all Means Test dependents
162 F IVMSUB=0:0 S IVMSUB=$O(DGREL("C",IVMSUB)) Q:'IVMSUB D
163 .;
164 .; - create (ZDP) Dependent Info. segment for dependent child
165 .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZDP(+$G(DGREL("C",IVMSUB)),"1,2,3,4,5,6,7,9,10")
166 .I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
167 ..; - pass non-existant SSNs as 0s
168 ..S $P(X,HLFS,6)="000000000"
169 .;
170 .; - create (ZIC) Income segment for dependent child
171 .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("C",IVMSUB)),"1,2,3,4,5,6,7,8,9,10,11,12,15")
172 .I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
173 .;
174 .; - create (ZIR) Income Relation segment for dependent child
175 .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("C",IVMSUB)),"1,2,3,6,7,8,9,14")
176 .I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^"_$P(^TMP("HLS",$J,IVMCT),"^",2)
177 .;
178 ;
179 D GOTO^IVMPTRN9
180 Q
Note: See TracBrowser for help on using the repository browser.