IVMCME ;ALB/SEK,BRM,TDM - DCD INCOME TEST EDIT CHECK DRIVER ; 3/22/06 4:12pm
;;2.0;INCOME VERIFICATION MATCH;**17,49,58,115**;21-OCT-94;Build 28
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will perform edit checks to validate income tests
; which are transmitted to DHCP from that Data Collection Division
; of the IVM Center. Any errors will be recorded and will be sent
; automatically to the IVM Center for processing.
;
; This routine is called from IVMCM1.
;
; Required Input:
; The global array ^TMP($J,"IVMCM" which contains the income test
; The local variable IVMTYPE, which may be:
; 1 - Means Test
; 2 - Copay Test
; 3 - Income Screening information only
; 4 - Long Term Care Test
;
; Output:
; IVMMTERR as error condition found (free text)
;
EN() ; Entry point to begin edit checks.
;
N ARRAY,DEP,ERROR,I,IEN,SPOUSE,STRING,TYPE,X,Y
S ERROR=""
;
I '$G(IVMTYPE) S ERROR="Income Test Type not Specified" G ENQ
;
; - build strings for the veteran
S SPOUSE=0,DEP=1
;S ARRAY("PID")=$$CLEAR($G(^TMP($J,"IVMCM","PIDV")))
S X=0 F S X=$O(^TMP($J,"IVMCM","PIDV",X)) Q:X="" D
.I $D(^TMP($J,"IVMCM","PIDV",X))=1 D
..S ARRAY("PID",X)=$$CLEAR(^TMP($J,"IVMCM","PIDV",X))
.I $D(^TMP($J,"IVMCM","PIDV",X))=10 D
..S Y=0 F S Y=$O(^TMP($J,"IVMCM","PIDV",X,Y)) Q:Y="" D
...S ARRAY("PID",X,Y)=$$CLEAR(^TMP($J,"IVMCM","PIDV",X,Y))
;
S ARRAY("ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICV"))),$P(ARRAY("ZIC"),HLFS,21)=$$TOTAL(ARRAY("ZIC"))
S ARRAY("ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRV")))
;
; - build strings for spouse as dependent
S ARRAY(DEP,"ZDP")=$$CLEAR($G(^TMP($J,"IVMCM","ZDPS")))
S ARRAY(DEP,"ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICS")))
S ARRAY(DEP,"ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRS")))
D ADJ
;
; - build strings for children as dependents
S IEN=0 F S IEN=$O(^TMP($J,"IVMCM","ZDPC",IEN)) Q:'IEN D
. S DEP=DEP+1
. S ARRAY(DEP,"ZDP")=$$CLEAR($G(^TMP($J,"IVMCM","ZDPC",IEN)))
. S ARRAY(DEP,"ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICC",IEN)))
. S ARRAY(DEP,"ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRC",IEN)))
. D ADJ
;
; - build income test string and check for errors
S ARRAY("ZMT")=$$CLEAR($G(^TMP($J,"IVMCM","ZMT"_IVMTYPE)))
S ERROR=$$CHECK()
ENQ Q ERROR
;
;
CHECK() ; check validity of transmission data
;
; Output: error message (first one found)
;
N ERROR,IEN
S ERROR=$$ZIC^IVMCME2(ARRAY("ZIC"))
I ERROR']"" S ERROR=$$ZIR^IVMCME1(ARRAY("ZIR"))
I ERROR']"","^1^2^4^"[("^"_IVMTYPE_"^") S ERROR=$$ZMT^IVMCME4(ARRAY("ZMT"))
I ERROR']"" F IEN=0:0 S IEN=$O(ARRAY(IEN)) Q:'IEN D I ERROR]"" G CHECKQ ; check dependent segments
. S ERROR=$$ZDP^IVMCME3(ARRAY(IEN,"ZDP"),IEN)
. I ERROR']"" S ERROR=$$ZIC^IVMCME2(ARRAY(IEN,"ZIC"),IEN)
. I ERROR']"" S ERROR=$$ZIR^IVMCME1(ARRAY(IEN,"ZIR"),IEN)
CHECKQ Q ERROR
;
;
CLEAR(NODE) ; convert HLQ to null
N I
F I=1:1:$L(NODE,HLFS) I $P(NODE,HLFS,I)=HLQ S $P(NODE,HLFS,I)=""
Q NODE
;
;
TOTAL(STRING,INCR,DEP) ; append total on the end
N I,D,N,INC,DEB,NET S (INC,DEB,NET)=""
INC ; income
I $D(INCR),$P($G(DEP),HLFS,6)'=2,'$P(INCR,HLFS,9) S INC=0 G DEBT
F I=3:1:12 S INC=$G(INC)+$P(STRING,HLFS,I)
DEBT ; debts
F I=13:1:15 S DEB=$G(DEB)+$P(STRING,HLFS,I)
NET ; net worth
F I=16:1:19 I $P(STRING,HLFS,I)]"" S NET=$G(NET)+$P(STRING,HLFS,I)
I NET]"" S NET=NET-$P(STRING,HLFS,20)
Q INC_HLFS_DEB_HLFS_NET
;
;
ADJ ; Adjust spouse dependent's strings
I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)'="^^" S SPOUSE=DEP
I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)="^^" K ARRAY(DEP) S DEP=DEP-1
I DEP S $P(ARRAY(DEP,"ZIC"),HLFS,21)=$$TOTAL(ARRAY(DEP,"ZIC"),ARRAY(DEP,"ZIR"),ARRAY(DEP,"ZDP"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCME 3804 printed Oct 16, 2024@18:02:07 Page 2
IVMCME ;ALB/SEK,BRM,TDM - DCD INCOME TEST EDIT CHECK DRIVER ; 3/22/06 4:12pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**17,49,58,115**;21-OCT-94;Build 28
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will perform edit checks to validate income tests
+5 ; which are transmitted to DHCP from that Data Collection Division
+6 ; of the IVM Center. Any errors will be recorded and will be sent
+7 ; automatically to the IVM Center for processing.
+8 ;
+9 ; This routine is called from IVMCM1.
+10 ;
+11 ; Required Input:
+12 ; The global array ^TMP($J,"IVMCM" which contains the income test
+13 ; The local variable IVMTYPE, which may be:
+14 ; 1 - Means Test
+15 ; 2 - Copay Test
+16 ; 3 - Income Screening information only
+17 ; 4 - Long Term Care Test
+18 ;
+19 ; Output:
+20 ; IVMMTERR as error condition found (free text)
+21 ;
EN() ; Entry point to begin edit checks.
+1 ;
+2 NEW ARRAY,DEP,ERROR,I,IEN,SPOUSE,STRING,TYPE,X,Y
+3 SET ERROR=""
+4 ;
+5 IF '$GET(IVMTYPE)
SET ERROR="Income Test Type not Specified"
GOTO ENQ
+6 ;
+7 ; - build strings for the veteran
+8 SET SPOUSE=0
SET DEP=1
+9 ;S ARRAY("PID")=$$CLEAR($G(^TMP($J,"IVMCM","PIDV")))
+10 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"IVMCM","PIDV",X))
if X=""
QUIT
Begin DoDot:1
+11 IF $DATA(^TMP($JOB,"IVMCM","PIDV",X))=1
Begin DoDot:2
+12 SET ARRAY("PID",X)=$$CLEAR(^TMP($JOB,"IVMCM","PIDV",X))
End DoDot:2
+13 IF $DATA(^TMP($JOB,"IVMCM","PIDV",X))=10
Begin DoDot:2
+14 SET Y=0
FOR
SET Y=$ORDER(^TMP($JOB,"IVMCM","PIDV",X,Y))
if Y=""
QUIT
Begin DoDot:3
+15 SET ARRAY("PID",X,Y)=$$CLEAR(^TMP($JOB,"IVMCM","PIDV",X,Y))
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 SET ARRAY("ZIC")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZICV")))
SET $PIECE(ARRAY("ZIC"),HLFS,21)=$$TOTAL(ARRAY("ZIC"))
+18 SET ARRAY("ZIR")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZIRV")))
+19 ;
+20 ; - build strings for spouse as dependent
+21 SET ARRAY(DEP,"ZDP")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZDPS")))
+22 SET ARRAY(DEP,"ZIC")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZICS")))
+23 SET ARRAY(DEP,"ZIR")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZIRS")))
+24 DO ADJ
+25 ;
+26 ; - build strings for children as dependents
+27 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"IVMCM","ZDPC",IEN))
if 'IEN
QUIT
Begin DoDot:1
+28 SET DEP=DEP+1
+29 SET ARRAY(DEP,"ZDP")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZDPC",IEN)))
+30 SET ARRAY(DEP,"ZIC")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZICC",IEN)))
+31 SET ARRAY(DEP,"ZIR")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZIRC",IEN)))
+32 DO ADJ
End DoDot:1
+33 ;
+34 ; - build income test string and check for errors
+35 SET ARRAY("ZMT")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZMT"_IVMTYPE)))
+36 SET ERROR=$$CHECK()
ENQ QUIT ERROR
+1 ;
+2 ;
CHECK() ; check validity of transmission data
+1 ;
+2 ; Output: error message (first one found)
+3 ;
+4 NEW ERROR,IEN
+5 SET ERROR=$$ZIC^IVMCME2(ARRAY("ZIC"))
+6 IF ERROR']""
SET ERROR=$$ZIR^IVMCME1(ARRAY("ZIR"))
+7 IF ERROR']""
IF "^1^2^4^"[("^"_IVMTYPE_"^")
SET ERROR=$$ZMT^IVMCME4(ARRAY("ZMT"))
+8 ; check dependent segments
IF ERROR']""
FOR IEN=0:0
SET IEN=$ORDER(ARRAY(IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 SET ERROR=$$ZDP^IVMCME3(ARRAY(IEN,"ZDP"),IEN)
+10 IF ERROR']""
SET ERROR=$$ZIC^IVMCME2(ARRAY(IEN,"ZIC"),IEN)
+11 IF ERROR']""
SET ERROR=$$ZIR^IVMCME1(ARRAY(IEN,"ZIR"),IEN)
End DoDot:1
IF ERROR]""
GOTO CHECKQ
CHECKQ QUIT ERROR
+1 ;
+2 ;
CLEAR(NODE) ; convert HLQ to null
+1 NEW I
+2 FOR I=1:1:$LENGTH(NODE,HLFS)
IF $PIECE(NODE,HLFS,I)=HLQ
SET $PIECE(NODE,HLFS,I)=""
+3 QUIT NODE
+4 ;
+5 ;
TOTAL(STRING,INCR,DEP) ; append total on the end
+1 NEW I,D,N,INC,DEB,NET
SET (INC,DEB,NET)=""
INC ; income
+1 IF $DATA(INCR)
IF $PIECE($GET(DEP),HLFS,6)'=2
IF '$PIECE(INCR,HLFS,9)
SET INC=0
GOTO DEBT
+2 FOR I=3:1:12
SET INC=$GET(INC)+$PIECE(STRING,HLFS,I)
DEBT ; debts
+1 FOR I=13:1:15
SET DEB=$GET(DEB)+$PIECE(STRING,HLFS,I)
NET ; net worth
+1 FOR I=16:1:19
IF $PIECE(STRING,HLFS,I)]""
SET NET=$GET(NET)+$PIECE(STRING,HLFS,I)
+2 IF NET]""
SET NET=NET-$PIECE(STRING,HLFS,20)
+3 QUIT INC_HLFS_DEB_HLFS_NET
+4 ;
+5 ;
ADJ ; Adjust spouse dependent's strings
+1 IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,6)=2
IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,2,4)'="^^"
SET SPOUSE=DEP
+2 IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,6)=2
IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,2,4)="^^"
KILL ARRAY(DEP)
SET DEP=DEP-1
+3 IF DEP
SET $PIECE(ARRAY(DEP,"ZIC"),HLFS,21)=$$TOTAL(ARRAY(DEP,"ZIC"),ARRAY(DEP,"ZIR"),ARRAY(DEP,"ZDP"))
+4 QUIT
