- 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)