- IVMCME2 ;ALB/SEK,BRM - CHECK ANNUAL INCOME DATA ; 12/18/01 2:19pm
- ;;2.0;INCOME VERIFICATION MATCH;**17,49**;21-OCT-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; This routine is called from IVMCME.
- ;
- ;
- ZIC(STRING,DEPIEN) ; check validity of ZIC segment
- ;
- ; Input: STRING as ZIC segment
- ; DEPIEN as the IEN of the dependent in the array, if applicable
- ;
- ; Output: ERROR message or null
- ;
- N ERROR,FLAG,I,X,Y
- S ERROR="",X=$P(STRING,HLFS,2),FLAG=0
- I $E(X,1,4)<1992!($E(X,5,8)'="0000") S ERROR="Invalid Income Year in ZIC" G ZICQ
- F I=3:1:20 I $$NUM($P(STRING,HLFS,I),7,2) S ERROR=$P($T(ZICFLD+I),";;",2)_" field content/length error" Q
- I ERROR]"" G ZICQ
- I $G(DEPIEN) D I ERROR]"" G ZICQ
- . F I=13,14 I $P(STRING,HLFS,I)]"" S ERROR="Dependents can't have medical or funeral expenses" Q
- . I DEPIEN=SPOUSE,($P(STRING,HLFS,15)]"") S ERROR="No educational expenses for spouse" Q
- . I DEPIEN'=SPOUSE D Q:ERROR]""
- . . I $P(STRING,HLFS,15)&('$P(ARRAY(DEPIEN,"ZIR"),U,9)) S ERROR="Dependent Educational Exp. error-income not avail. to vet" Q
- . . S X=$E($P(STRING,HLFS,2),1,4) D ^%DT S X=Y
- . . I $P(STRING,HLFS,15)]"" S X=$P(^DG(43,1,"MT",X,0),U,17) I X'<$P(STRING,HLFS,9) S ERROR="Income does not exceed child exclusion amount-educational expense not allowed" Q
- . . F I=16:1:20 I $P(STRING,HLFS,I)]"" S ERROR="No net worth figures allowed for dependent children"
- I $P(STRING,HLFS,20)>$P(STRING,HLFS,19) S ERROR="Debts can't be greater than Other Property or Assets" G ZICQ
- I '$G(DEPIEN) D I ERROR]"" G ZICQ
- . I IVMTYPE'=1 Q
- . I $P(ARRAY("ZMT"),HLFS,3)="C" Q
- . S FLAG=0 F I=16:1:20 I $P(STRING,HLFS,I)]"" S FLAG=1 Q
- . I 'FLAG,SPOUSE F I=16:1:20 I $P(ARRAY(SPOUSE,"ZIC"),HLFS,I)]"" S FLAG=1 Q
- ZICQ Q ERROR
- ;
- ;
- NUM(NUMBER,DIGIT,DECIMAL) ; function to determine if valid numeric value
- ;
- ; Input: NUMBER as data element to evaluate
- ; DIGIT as number of digits allowed
- ; DECIMAL as number of decimal places
- ;
- N ERROR
- S ERROR=0
- I NUMBER'?.N.1".".2N S ERROR=1 G NUMQ
- I $L($P(NUMBER,".",1))>DIGIT S ERROR=1 G NUMQ
- I NUMBER<0 S ERROR=1
- NUMQ Q ERROR
- ;
- ;
- ZICFLD ; ZIC field names
- ;;
- ;;INCOME YEAR
- ;;SOCIAL SECURITY
- ;;US CIVIL SERVICE
- ;;US RAILROAD RETIREMENT
- ;;MILITARY RETIREMENT
- ;;UNEMPLOYMENT COMPENSATION
- ;;OTHER RETIREMENT
- ;;EMPLOYMENT INCOME
- ;;INTEREST, DIVIDEND, ANNUITY
- ;;WORKERS COMP/BLACK LUNG
- ;;OTHER INCOME
- ;;MEDICAL EXPENSES
- ;;FUNERAL AND BURIAL EXPENSES
- ;;EDUCATIONAL EXPENSES
- ;;CASH AMOUNT IN BANK ACCOUNTS
- ;;STOCKS AND BONDS
- ;;REAL PROPERTY
- ;;OTHER PROPERTY OR ASSETS
- ;;DEBTS
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCME2 2658 printed Feb 18, 2025@23:27:01 Page 2
- IVMCME2 ;ALB/SEK,BRM - CHECK ANNUAL INCOME DATA ; 12/18/01 2:19pm
- +1 ;;2.0;INCOME VERIFICATION MATCH;**17,49**;21-OCT-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; This routine is called from IVMCME.
- +5 ;
- +6 ;
- ZIC(STRING,DEPIEN) ; check validity of ZIC segment
- +1 ;
- +2 ; Input: STRING as ZIC segment
- +3 ; DEPIEN as the IEN of the dependent in the array, if applicable
- +4 ;
- +5 ; Output: ERROR message or null
- +6 ;
- +7 NEW ERROR,FLAG,I,X,Y
- +8 SET ERROR=""
- SET X=$PIECE(STRING,HLFS,2)
- SET FLAG=0
- +9 IF $EXTRACT(X,1,4)<1992!($EXTRACT(X,5,8)'="0000")
- SET ERROR="Invalid Income Year in ZIC"
- GOTO ZICQ
- +10 FOR I=3:1:20
- IF $$NUM($PIECE(STRING,HLFS,I),7,2)
- SET ERROR=$PIECE($TEXT(ZICFLD+I),";;",2)_" field content/length error"
- QUIT
- +11 IF ERROR]""
- GOTO ZICQ
- +12 IF $GET(DEPIEN)
- Begin DoDot:1
- +13 FOR I=13,14
- IF $PIECE(STRING,HLFS,I)]""
- SET ERROR="Dependents can't have medical or funeral expenses"
- QUIT
- +14 IF DEPIEN=SPOUSE
- IF ($PIECE(STRING,HLFS,15)]"")
- SET ERROR="No educational expenses for spouse"
- QUIT
- +15 IF DEPIEN'=SPOUSE
- Begin DoDot:2
- +16 IF $PIECE(STRING,HLFS,15)&('$PIECE(ARRAY(DEPIEN,"ZIR"),U,9))
- SET ERROR="Dependent Educational Exp. error-income not avail. to vet"
- QUIT
- +17 SET X=$EXTRACT($PIECE(STRING,HLFS,2),1,4)
- DO ^%DT
- SET X=Y
- +18 IF $PIECE(STRING,HLFS,15)]""
- SET X=$PIECE(^DG(43,1,"MT",X,0),U,17)
- IF X'<$PIECE(STRING,HLFS,9)
- SET ERROR="Income does not exceed child exclusion amount-educational expense not allowed"
- QUIT
- +19 FOR I=16:1:20
- IF $PIECE(STRING,HLFS,I)]""
- SET ERROR="No net worth figures allowed for dependent children"
- End DoDot:2
- if ERROR]""
- QUIT
- End DoDot:1
- IF ERROR]""
- GOTO ZICQ
- +20 IF $PIECE(STRING,HLFS,20)>$PIECE(STRING,HLFS,19)
- SET ERROR="Debts can't be greater than Other Property or Assets"
- GOTO ZICQ
- +21 IF '$GET(DEPIEN)
- Begin DoDot:1
- +22 IF IVMTYPE'=1
- QUIT
- +23 IF $PIECE(ARRAY("ZMT"),HLFS,3)="C"
- QUIT
- +24 SET FLAG=0
- FOR I=16:1:20
- IF $PIECE(STRING,HLFS,I)]""
- SET FLAG=1
- QUIT
- +25 IF 'FLAG
- IF SPOUSE
- FOR I=16:1:20
- IF $PIECE(ARRAY(SPOUSE,"ZIC"),HLFS,I)]""
- SET FLAG=1
- QUIT
- End DoDot:1
- IF ERROR]""
- GOTO ZICQ
- ZICQ QUIT ERROR
- +1 ;
- +2 ;
- NUM(NUMBER,DIGIT,DECIMAL) ; function to determine if valid numeric value
- +1 ;
- +2 ; Input: NUMBER as data element to evaluate
- +3 ; DIGIT as number of digits allowed
- +4 ; DECIMAL as number of decimal places
- +5 ;
- +6 NEW ERROR
- +7 SET ERROR=0
- +8 IF NUMBER'?.N.1".".2N
- SET ERROR=1
- GOTO NUMQ
- +9 IF $LENGTH($PIECE(NUMBER,".",1))>DIGIT
- SET ERROR=1
- GOTO NUMQ
- +10 IF NUMBER<0
- SET ERROR=1
- NUMQ QUIT ERROR
- +1 ;
- +2 ;
- ZICFLD ; ZIC field names
- +1 ;;
- +2 ;;INCOME YEAR
- +3 ;;SOCIAL SECURITY
- +4 ;;US CIVIL SERVICE
- +5 ;;US RAILROAD RETIREMENT
- +6 ;;MILITARY RETIREMENT
- +7 ;;UNEMPLOYMENT COMPENSATION
- +8 ;;OTHER RETIREMENT
- +9 ;;EMPLOYMENT INCOME
- +10 ;;INTEREST, DIVIDEND, ANNUITY
- +11 ;;WORKERS COMP/BLACK LUNG
- +12 ;;OTHER INCOME
- +13 ;;MEDICAL EXPENSES
- +14 ;;FUNERAL AND BURIAL EXPENSES
- +15 ;;EDUCATIONAL EXPENSES
- +16 ;;CASH AMOUNT IN BANK ACCOUNTS
- +17 ;;STOCKS AND BONDS
- +18 ;;REAL PROPERTY
- +19 ;;OTHER PROPERTY OR ASSETS
- +20 ;;DEBTS