source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLZIR.m@ 1800

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1VAFHLZIR ;ALB/SEK,TDM - Create generic HL7 ZIR segment ; 9/19/05 11:47am
2 ;;5.3;Registration;**33,94,151,466,653**;Aug 13, 1993;Build 2
3 ;
4 ;
5EN(VAFIEN,VAFSTR,VAFNUM,VAFENC) ; This generic extrinsic function was designed to
6 ; return the HL7 ZIR segment. This segment contains
7 ; VA-specific information pertaining to income relation type
8 ; data for a veteran and any applicable relations.
9 ;
10 ; Input - VAFIEN as internal entry number of the INCOME RELATION file.
11 ; VAFSTR as the string of fields requested seperated by commas.
12 ; VAFNUM as the number desired for the SET ID (default = 1)
13 ; VAFENC as Outpatient Encounter IEN (from file #409.68)
14 ;
15 ; NOTE: Input variable VAFENC was added as part of the Ambulatory
16 ; Care Reporting project.
17 ;
18 ; *****Also assumes all HL7 variables returned from*****
19 ; INIT^HLTRANS are defined.
20 ;
21 ; Output - String of data forming the ZIR segment.
22 ;
23 ;
24 N VAFDFN,VAFERR,VAFENODE,VAFNODE,VAFY,X
25 I $G(VAFSTR)']"" G QUIT
26 S VAFENC=+$G(VAFENC)
27 I '$G(VAFIEN)&('VAFENC) G QUIT
28 S $P(VAFY,HLFS,14)="",VAFSTR=","_VAFSTR_","
29 S VAFNODE=$G(^DGMT(408.22,+$G(VAFIEN),0))
30 I $G(VAFNODE)']""&('VAFENC) G QUIT
31 S $P(VAFY,HLFS,1)=$S($G(VAFNUM):VAFNUM,1:1)
32 I VAFSTR[",2," S $P(VAFY,HLFS,2)=$$YN^VAFHLFNC($P(VAFNODE,"^",5)) ; Married last calendar year
33 I VAFSTR[",3," S $P(VAFY,HLFS,3)=$$YN^VAFHLFNC($P(VAFNODE,"^",6)) ; Lived with patient
34 I VAFSTR[",4," S X=$P(VAFNODE,"^",7),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; Amount contributed to spouse
35 I VAFSTR[",5," S $P(VAFY,HLFS,5)=$$YN^VAFHLFNC($P(VAFNODE,"^",8)) ; Dependent children (y/n)
36 I VAFSTR[",6," S $P(VAFY,HLFS,6)=$$YN^VAFHLFNC($P(VAFNODE,"^",9)) ; Incapable of self-support
37 I VAFSTR[",7," S $P(VAFY,HLFS,7)=$$YN^VAFHLFNC($P(VAFNODE,"^",10)) ; Contributed to support
38 I VAFSTR[",8," S $P(VAFY,HLFS,8)=$$YN^VAFHLFNC($P(VAFNODE,"^",11)) ; Child had income
39 I VAFSTR[",9," S $P(VAFY,HLFS,9)=$$YN^VAFHLFNC($P(VAFNODE,"^",12)) ; Income available to you
40 I VAFSTR[",10," S X=$P(VAFNODE,"^",13),$P(VAFY,HLFS,10)=$S(X]"":X,1:HLQ) ; Number of dependent children
41 ;
42 ; ALB/ESD - Data elements 11,12,13 added as part of Ambulatory Care
43 ; Reporting Project requirements.
44 ;
45 I VAFSTR[",11,"!(VAFSTR[",12,")!(VAFSTR[",13,") D
46 . ;
47 . ;- If no encounter ptr, encounter node or DFN elements 11 - 13 = HLQ
48 . I ('VAFENC) S VAFERR=1 Q
49 . S VAFENODE=$$SCE^DGSDU(VAFENC) I VAFENODE']"" S VAFERR=1 Q
50 . S VAFDFN=$P(VAFENODE,"^",2) S:VAFDFN="" VAFERR=1 Q
51 I VAFSTR[",11," S $P(VAFY,HLFS,11)=$S('$G(VAFERR):+$$DEP^VAFMON(VAFDFN,$P(VAFENODE,"^")),1:HLQ) ;Total Dependents
52 I VAFSTR[",12," S $P(VAFY,HLFS,12)=$S('$G(VAFERR):+$$INCOME^VAFMON(VAFDFN,$P(VAFENODE,"^")),1:HLQ) ;Patient Income
53 ;
54 ;- If outpat encounter node exists, get appointment type &
55 ; eligibility of encounter and make call to get means test indicator
56 I VAFSTR[",13," S $P(VAFY,HLFS,13)=$S('$G(VAFERR):$$MTI^SCDXUTL0(VAFDFN,$P(VAFENODE,"^"),$P(VAFENODE,"^",13),$P(VAFENODE,"^",10),VAFENC),1:HLQ) ;Means Test Indicator
57 ;
58 ;- If MT Indicator not = code AN, C, or G, change number of dependents
59 ; to XX (not applicable)
60 I VAFSTR[",11," I '$G(VAFERR) D
61 . I $P(VAFY,HLFS,13)'="AN"&($P(VAFY,HLFS,13)'="C")&($P(VAFY,HLFS,13)'="G") S $P(VAFY,HLFS,11)="XX" ;Total Dependents not applicable for MT indicators AS,N,X,U
62 ;
63 I VAFSTR[",14," S X=$P(VAFNODE,"^",18),$P(VAFY,HLFS,14)=$S(X=0:"N",X=1:"Y",1:HLQ) ; Dependent child school indicator
64 ;
65QUIT Q "ZIR"_HLFS_$G(VAFY)
Note: See TracBrowser for help on using the repository browser.