IVMCMF ;ALB/RMM,TDM - INCOME TEST EDIT CHECK DRIVER ; 2/1/07 10:14am
;;2.0;INCOME VERIFICATION MATCH;**71,82,107,115**;21-OCT-94;Build 28
;
; This routine will perform edit checks to validate income tests which
; are transmitted to VistA from the IVM Center. Any errors will be
; recorded and will be added to the record in the ANNUAL MEANS TEST
; File #408.31.
;
; 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
; 4 - Long Term Care Test
;
; Output:
; Array IVMERR as a list of error condition(s) found (free text)
;
EN(IVMERR) ; Entry point to begin edit checks.
;
N ARRAY,DEP,I,IEN,SPOUSE,CNT,HLERR,ISEG,J
S (DEP,CNT)=1,SPOUSE=0
I +$G(IVMTYPE)'>0 S CNT=CNT+1,IVMERR(CNT)="Income Test Type not Specified"
;
; Build strings for the veteran
;S ARRAY("PID")=$$CLEAR($G(^TMP($J,"IVMCM","PIDV")))
S I=0 F S I=$O(^TMP($J,"IVMCM","PIDV",I)) Q:I="" D
.I $D(^TMP($J,"IVMCM","PIDV",I))=1 D
..S ARRAY("PID",I)=$$CLEAR(^TMP($J,"IVMCM","PIDV",I))
.I $D(^TMP($J,"IVMCM","PIDV",I))=10 D
..S J=0 F S J=$O(^TMP($J,"IVMCM","PIDV",I,J)) Q:J="" D
...S ARRAY("PID",I,J)=$$CLEAR(^TMP($J,"IVMCM","PIDV",I,J))
;
S ARRAY("ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICV"))),$P(ARRAY("ZIC"),HLFS,21)=$$TOTAL^IVMCME(ARRAY("ZIC"))
S ARRAY("ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRV")))
;
; Build string 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^IVMCME
;
; 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^IVMCME
;
; Build strings for inactive spouse and children dependents
F ISEG="ZDPIS","ZDPIC" D
. S IEN=0 F S IEN=$O(^TMP($J,"IVMCM",ISEG,IEN)) Q:'IEN D
. . S DEP=DEP+1
. . S ARRAY(DEP,"ZDP")=$$CLEAR($G(^TMP($J,"IVMCM",ISEG,IEN)))
;
; - build income test string and check for errors
S ARRAY("ZMT")=$$CLEAR($G(^TMP($J,"IVMCM","ZMT"_IVMTYPE)))
;
I '$$UPLDOK() S HLERR="Income Test not Uploaded",OK2UPLD=0 D ACK^IVMPREC Q
;
; Check Income Test before applying consistency checks
; - If AGREED TO PAY DEDUCTIBLE is NO
; - or DECLINES TO GIVE INCOME INFO and AGREED TO PAY DEDUCTIBLE are YES
; Quit, the consistency checks are unnecessary.
N APD,DTGII S APD=$P(ARRAY("ZMT"),U,11),DTGII=$P(ARRAY("ZMT"),U,14)
I APD=0!(APD=1&(DTGII=1)) Q
;
D CHECK
ENQ Q
;
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
;
CHECK ; Check validity of transmission data
N IEN
I "^1^2^4^"[("^"_IVMTYPE_"^") D ZMT^IVMCMF2(ARRAY("ZMT"))
D ZIR^IVMCMF1(ARRAY("ZIR"))
;
S IEN="" F S IEN=$O(ARRAY(IEN)) Q:'IEN D
. D ZDP^IVMCMF2(ARRAY(IEN,"ZDP"))
. I $D(ARRAY(IEN,"ZIC")) D ZIC^IVMCMF1(ARRAY(IEN,"ZIC"),IEN)
. I $D(ARRAY(IEN,"ZIR")) D ZIR^IVMCMF1(ARRAY(IEN,"ZIR"),IEN)
CHECKQ Q
;
UPLDOK() ; Check if the test is complete and OK to upload
; Quit if not a valid test type
I "^1^2^3^4^"'[(U_IVMTYPE_U) Q 0
;
; Check the Income Test Status
N DGSTAT S DGSTAT=$P(ARRAY("ZMT"),U,3)
I IVMTYPE=1,"^C^A^G^N^P^"'[(U_DGSTAT_U) Q 0
I IVMTYPE=2,"^M^E^L^"'[(U_DGSTAT_U) Q 0
I IVMTYPE=4,"^0^1^"'[(U_DGSTAT_U) Q 0
;
; Check if the test has been completed
I IVMTYPE'=3,+$P(ARRAY("ZMT"),U,10)'>0 Q 0
Q 1
;
UPDMTSIG(MTIEN,TMSTAMP,MTSIG,MTSIGDT) ;
;if the timestamp matchs AND MT Sig or MT Sig Date changed, update MT Sig info
I '$G(MTIEN) Q 0
S MTSIG=$G(MTSIG),MTSIGDT=$G(MTSIGDT)
N ND0,ND2,DATA
S ND2=$G(^DGMT(408.31,MTIEN,2))
I $G(TMSTAMP)'=$P(ND2,"^",2) Q 0
S ND0=$G(^DGMT(408.31,MTIEN,0))
I MTSIG=$P(ND0,"^",29)&(MTSIGDT=$P(ND0,"^",24)) Q 0
S DATA(.24)=MTSIGDT ; dt vet signed test
S DATA(.29)=MTSIG ; means test signed
I $$UPD^DGENDBS(408.31,MTIEN,.DATA)
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCMF 4266 printed Oct 16, 2024@18:02:12 Page 2
IVMCMF ;ALB/RMM,TDM - INCOME TEST EDIT CHECK DRIVER ; 2/1/07 10:14am
+1 ;;2.0;INCOME VERIFICATION MATCH;**71,82,107,115**;21-OCT-94;Build 28
+2 ;
+3 ; This routine will perform edit checks to validate income tests which
+4 ; are transmitted to VistA from the IVM Center. Any errors will be
+5 ; recorded and will be added to the record in the ANNUAL MEANS TEST
+6 ; File #408.31.
+7 ;
+8 ; This routine is called from IVMCM1.
+9 ;
+10 ; Required Input:
+11 ; The global array ^TMP($J,"IVMCM" which contains the income test
+12 ; The local variable IVMTYPE, which may be:
+13 ; 1 - Means Test
+14 ; 2 - Copay Test
+15 ; 4 - Long Term Care Test
+16 ;
+17 ; Output:
+18 ; Array IVMERR as a list of error condition(s) found (free text)
+19 ;
EN(IVMERR) ; Entry point to begin edit checks.
+1 ;
+2 NEW ARRAY,DEP,I,IEN,SPOUSE,CNT,HLERR,ISEG,J
+3 SET (DEP,CNT)=1
SET SPOUSE=0
+4 IF +$GET(IVMTYPE)'>0
SET CNT=CNT+1
SET IVMERR(CNT)="Income Test Type not Specified"
+5 ;
+6 ; Build strings for the veteran
+7 ;S ARRAY("PID")=$$CLEAR($G(^TMP($J,"IVMCM","PIDV")))
+8 SET I=0
FOR
SET I=$ORDER(^TMP($JOB,"IVMCM","PIDV",I))
if I=""
QUIT
Begin DoDot:1
+9 IF $DATA(^TMP($JOB,"IVMCM","PIDV",I))=1
Begin DoDot:2
+10 SET ARRAY("PID",I)=$$CLEAR(^TMP($JOB,"IVMCM","PIDV",I))
End DoDot:2
+11 IF $DATA(^TMP($JOB,"IVMCM","PIDV",I))=10
Begin DoDot:2
+12 SET J=0
FOR
SET J=$ORDER(^TMP($JOB,"IVMCM","PIDV",I,J))
if J=""
QUIT
Begin DoDot:3
+13 SET ARRAY("PID",I,J)=$$CLEAR(^TMP($JOB,"IVMCM","PIDV",I,J))
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 SET ARRAY("ZIC")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZICV")))
SET $PIECE(ARRAY("ZIC"),HLFS,21)=$$TOTAL^IVMCME(ARRAY("ZIC"))
+16 SET ARRAY("ZIR")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZIRV")))
+17 ;
+18 ; Build string for spouse as dependent
+19 SET ARRAY(DEP,"ZDP")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZDPS")))
+20 SET ARRAY(DEP,"ZIC")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZICS")))
+21 SET ARRAY(DEP,"ZIR")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZIRS")))
+22 DO ADJ^IVMCME
+23 ;
+24 ; Build strings for children as dependents
+25 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"IVMCM","ZDPC",IEN))
if 'IEN
QUIT
Begin DoDot:1
+26 SET DEP=DEP+1
+27 SET ARRAY(DEP,"ZDP")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZDPC",IEN)))
+28 SET ARRAY(DEP,"ZIC")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZICC",IEN)))
+29 SET ARRAY(DEP,"ZIR")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZIRC",IEN)))
+30 DO ADJ^IVMCME
End DoDot:1
+31 ;
+32 ; Build strings for inactive spouse and children dependents
+33 FOR ISEG="ZDPIS","ZDPIC"
Begin DoDot:1
+34 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"IVMCM",ISEG,IEN))
if 'IEN
QUIT
Begin DoDot:2
+35 SET DEP=DEP+1
+36 SET ARRAY(DEP,"ZDP")=$$CLEAR($GET(^TMP($JOB,"IVMCM",ISEG,IEN)))
End DoDot:2
End DoDot:1
+37 ;
+38 ; - build income test string and check for errors
+39 SET ARRAY("ZMT")=$$CLEAR($GET(^TMP($JOB,"IVMCM","ZMT"_IVMTYPE)))
+40 ;
+41 IF '$$UPLDOK()
SET HLERR="Income Test not Uploaded"
SET OK2UPLD=0
DO ACK^IVMPREC
QUIT
+42 ;
+43 ; Check Income Test before applying consistency checks
+44 ; - If AGREED TO PAY DEDUCTIBLE is NO
+45 ; - or DECLINES TO GIVE INCOME INFO and AGREED TO PAY DEDUCTIBLE are YES
+46 ; Quit, the consistency checks are unnecessary.
+47 NEW APD,DTGII
SET APD=$PIECE(ARRAY("ZMT"),U,11)
SET DTGII=$PIECE(ARRAY("ZMT"),U,14)
+48 IF APD=0!(APD=1&(DTGII=1))
QUIT
+49 ;
+50 DO CHECK
ENQ QUIT
+1 ;
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 ;
CHECK ; Check validity of transmission data
+1 NEW IEN
+2 IF "^1^2^4^"[("^"_IVMTYPE_"^")
DO ZMT^IVMCMF2(ARRAY("ZMT"))
+3 DO ZIR^IVMCMF1(ARRAY("ZIR"))
+4 ;
+5 SET IEN=""
FOR
SET IEN=$ORDER(ARRAY(IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 DO ZDP^IVMCMF2(ARRAY(IEN,"ZDP"))
+7 IF $DATA(ARRAY(IEN,"ZIC"))
DO ZIC^IVMCMF1(ARRAY(IEN,"ZIC"),IEN)
+8 IF $DATA(ARRAY(IEN,"ZIR"))
DO ZIR^IVMCMF1(ARRAY(IEN,"ZIR"),IEN)
End DoDot:1
CHECKQ QUIT
+1 ;
UPLDOK() ; Check if the test is complete and OK to upload
+1 ; Quit if not a valid test type
+2 IF "^1^2^3^4^"'[(U_IVMTYPE_U)
QUIT 0
+3 ;
+4 ; Check the Income Test Status
+5 NEW DGSTAT
SET DGSTAT=$PIECE(ARRAY("ZMT"),U,3)
+6 IF IVMTYPE=1
IF "^C^A^G^N^P^"'[(U_DGSTAT_U)
QUIT 0
+7 IF IVMTYPE=2
IF "^M^E^L^"'[(U_DGSTAT_U)
QUIT 0
+8 IF IVMTYPE=4
IF "^0^1^"'[(U_DGSTAT_U)
QUIT 0
+9 ;
+10 ; Check if the test has been completed
+11 IF IVMTYPE'=3
IF +$PIECE(ARRAY("ZMT"),U,10)'>0
QUIT 0
+12 QUIT 1
+13 ;
UPDMTSIG(MTIEN,TMSTAMP,MTSIG,MTSIGDT) ;
+1 ;if the timestamp matchs AND MT Sig or MT Sig Date changed, update MT Sig info
+2 IF '$GET(MTIEN)
QUIT 0
+3 SET MTSIG=$GET(MTSIG)
SET MTSIGDT=$GET(MTSIGDT)
+4 NEW ND0,ND2,DATA
+5 SET ND2=$GET(^DGMT(408.31,MTIEN,2))
+6 IF $GET(TMSTAMP)'=$PIECE(ND2,"^",2)
QUIT 0
+7 SET ND0=$GET(^DGMT(408.31,MTIEN,0))
+8 IF MTSIG=$PIECE(ND0,"^",29)&(MTSIGDT=$PIECE(ND0,"^",24))
QUIT 0
+9 ; dt vet signed test
SET DATA(.24)=MTSIGDT
+10 ; means test signed
SET DATA(.29)=MTSIG
+11 IF $$UPD^DGENDBS(408.31,MTIEN,.DATA)
+12 QUIT 1
