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

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1VAFHLZIC ;ALB/ESD - Creation of ZIC segment ; 7 April 93
2 ;;5.3;Registration;**122,182**;Aug 13, 1993
3 ;
4 ; This generic extrinsic function transfers information pertaining to
5 ; a patient's individual annual income through the VA-Specific Income
6 ; (ZIC) segment.
7 ;
8 ;
9EN(VAFIEN,VAFSTR,VAFNUM) ;function returns ZIC segment containing individual annual income.
10 ;
11 ; Input:
12 ; VAFIEN -- Internal entry number in the Individual Annual
13 ; Income file.
14 ; VAFSTR -- String of fields requested separated by commas.
15 ; VAFNUM -- Set Id (sequential number-if not passed, set
16 ; to 1).
17 ;
18 ; Output: String of components forming ZIC segment.
19 ;
20 ; ****Also assumes all HL7 variables returned from****
21 ; INIT^HLTRANS are defined.
22 ;
23 N X,VAFNODE0,VAFNODE1,VAFNODE2,VAFNODE3,VAFY
24 I $G(VAFSTR)']"" G QUIT
25 S $P(VAFY,HLFS,20)="",VAFSTR=","_VAFSTR_","
26 S VAFNODE0=$G(^DGMT(408.21,VAFIEN,0)),VAFNODE1=$G(^(1)),VAFNODE2=$G(^(2)),VAFNODE3=$G(^("USR"))
27 S $P(VAFY,HLFS,1)=$S($G(VAFNUM):+VAFNUM\1,1:1) ; If Set Id not passed in, set to 1
28 I VAFSTR[",2," S X=$P(VAFNODE0,"^",1),$P(VAFY,HLFS,2)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ) ; Income Year
29 I VAFSTR[",3," S X=$P(VAFNODE0,"^",8),$P(VAFY,HLFS,3)=$S(X]"":X,1:HLQ) ; Social Security
30 I VAFSTR[",4," S X=$P(VAFNODE0,"^",9),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; U.S. Civil Service
31 I VAFSTR[",5," S X=$P(VAFNODE0,"^",10),$P(VAFY,HLFS,5)=$S(X]"":X,1:HLQ) ; U.S. RR Retirement
32 I VAFSTR[",6," S X=$P(VAFNODE0,"^",11),$P(VAFY,HLFS,6)=$S(X]"":X,1:HLQ) ; Military Retirement
33 I VAFSTR[",7," S X=$P(VAFNODE0,"^",12),$P(VAFY,HLFS,7)=$S(X]"":X,1:HLQ) ; Unemployment Compensation
34 I VAFSTR[",8," S X=$P(VAFNODE0,"^",13),$P(VAFY,HLFS,8)=$S(X]"":X,1:HLQ) ; Other Retirement
35 I VAFSTR[",9," S X=$P(VAFNODE0,"^",14),$P(VAFY,HLFS,9)=$S(X]"":X,1:HLQ) ; Employment Income
36 I VAFSTR[",10," S X=$P(VAFNODE0,"^",15),$P(VAFY,HLFS,10)=$S(X]"":X,1:HLQ) ; Interest, Dividend, Annuity
37 I VAFSTR[",11," S X=$P(VAFNODE0,"^",16),$P(VAFY,HLFS,11)=$S(X]"":X,1:HLQ) ; Workers Comp./Black Lung
38 I VAFSTR[",12," S X=$P(VAFNODE0,"^",17),$P(VAFY,HLFS,12)=$S(X]"":X,1:HLQ) ; Other Income
39 I VAFSTR[",13," S X=$P(VAFNODE1,"^",1),$P(VAFY,HLFS,13)=$S(X]"":X,1:HLQ) ; Medical Expenses
40 I VAFSTR[",14," S X=$P(VAFNODE1,"^",2),$P(VAFY,HLFS,14)=$S(X]"":X,1:HLQ) ; Funeral and Burial Expenses
41 I VAFSTR[",15," S X=$P(VAFNODE1,"^",3),$P(VAFY,HLFS,15)=$S(X]"":X,1:HLQ) ; Educational Expenses
42 I VAFSTR[",16," S X=$P(VAFNODE2,"^",1),$P(VAFY,HLFS,16)=$S(X]"":X,1:HLQ) ; Cash,Amounts in Bank Accounts
43 I VAFSTR[",17," S X=$P(VAFNODE2,"^",2),$P(VAFY,HLFS,17)=$S(X]"":X,1:HLQ) ; Stocks and Bonds
44 I VAFSTR[",18," S X=$P(VAFNODE2,"^",3),$P(VAFY,HLFS,18)=$S(X]"":X,1:HLQ) ; Real Property
45 I VAFSTR[",19," S X=$P(VAFNODE2,"^",4),$P(VAFY,HLFS,19)=$S(X]"":X,1:HLQ) ; Other Property and Assets
46 I VAFSTR[",20," S X=$P(VAFNODE2,"^",5),$P(VAFY,HLFS,20)=$S(X]"":X,1:HLQ) ; Debts
47 ;
48QUIT Q "ZIC"_HLFS_$G(VAFY)
Note: See TracBrowser for help on using the repository browser.