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