source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCME.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1IVMCME ;ALB/SEK,BRM,TDM - DCD INCOME TEST EDIT CHECK DRIVER ; 8/2/02 10:22am
2 ;;2.0;INCOME VERIFICATION MATCH;**17,49,58**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine will perform edit checks to validate income tests
6 ; which are transmitted to DHCP from that Data Collection Division
7 ; of the IVM Center. Any errors will be recorded and will be sent
8 ; automatically to the IVM Center for processing.
9 ;
10 ; This routine is called from IVMCM1.
11 ;
12 ; Required Input:
13 ; The global array ^TMP($J,"IVMCM" which contains the income test
14 ; The local variable IVMTYPE, which may be:
15 ; 1 - Means Test
16 ; 2 - Copay Test
17 ; 3 - Income Screening information only
18 ; 4 - Long Term Care Test
19 ;
20 ; Output:
21 ; IVMMTERR as error condition found (free text)
22 ;
23EN() ; Entry point to begin edit checks.
24 ;
25 N ARRAY,DEP,ERROR,I,IEN,SPOUSE,STRING,TYPE,X
26 S ERROR=""
27 ;
28 I '$G(IVMTYPE) S ERROR="Income Test Type not Specified" G ENQ
29 ;
30 ; - build strings for the veteran
31 S SPOUSE=0,DEP=1
32 S ARRAY("PID")=$$CLEAR($G(^TMP($J,"IVMCM","PIDV")))
33 S ARRAY("ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICV"))),$P(ARRAY("ZIC"),HLFS,21)=$$TOTAL(ARRAY("ZIC"))
34 S ARRAY("ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRV")))
35 ;
36 ; - build strings for spouse as dependent
37 S ARRAY(DEP,"ZDP")=$$CLEAR($G(^TMP($J,"IVMCM","ZDPS")))
38 S ARRAY(DEP,"ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICS")))
39 S ARRAY(DEP,"ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRS")))
40 D ADJ
41 ;
42 ; - build strings for children as dependents
43 S IEN=0 F S IEN=$O(^TMP($J,"IVMCM","ZDPC",IEN)) Q:'IEN D
44 . S DEP=DEP+1
45 . S ARRAY(DEP,"ZDP")=$$CLEAR($G(^TMP($J,"IVMCM","ZDPC",IEN)))
46 . S ARRAY(DEP,"ZIC")=$$CLEAR($G(^TMP($J,"IVMCM","ZICC",IEN)))
47 . S ARRAY(DEP,"ZIR")=$$CLEAR($G(^TMP($J,"IVMCM","ZIRC",IEN)))
48 . D ADJ
49 ;
50 ; - build income test string and check for errors
51 S ARRAY("ZMT")=$$CLEAR($G(^TMP($J,"IVMCM","ZMT"_IVMTYPE)))
52 S ERROR=$$CHECK()
53ENQ Q ERROR
54 ;
55 ;
56CHECK() ; check validity of transmission data
57 ;
58 ; Output: error message (first one found)
59 ;
60 N ERROR,IEN
61 S ERROR=$$ZIC^IVMCME2(ARRAY("ZIC"))
62 I ERROR']"" S ERROR=$$ZIR^IVMCME1(ARRAY("ZIR"))
63 I ERROR']"","^1^2^4^"[("^"_IVMTYPE_"^") S ERROR=$$ZMT^IVMCME4(ARRAY("ZMT"))
64 I ERROR']"" F IEN=0:0 S IEN=$O(ARRAY(IEN)) Q:'IEN D I ERROR]"" G CHECKQ ; check dependent segments
65 . S ERROR=$$ZDP^IVMCME3(ARRAY(IEN,"ZDP"),IEN)
66 . I ERROR']"" S ERROR=$$ZIC^IVMCME2(ARRAY(IEN,"ZIC"),IEN)
67 . I ERROR']"" S ERROR=$$ZIR^IVMCME1(ARRAY(IEN,"ZIR"),IEN)
68CHECKQ Q ERROR
69 ;
70 ;
71CLEAR(NODE) ; convert HLQ to null
72 N I
73 F I=1:1:$L(NODE,HLFS) I $P(NODE,HLFS,I)=HLQ S $P(NODE,HLFS,I)=""
74 Q NODE
75 ;
76 ;
77TOTAL(STRING,INCR,DEP) ; append total on the end
78 N I,D,N,INC,DEB,NET S (INC,DEB,NET)=""
79INC ; income
80 I $D(INCR),$P($G(DEP),HLFS,6)'=2,'$P(INCR,HLFS,9) S INC=0 G DEBT
81 F I=3:1:12 S INC=$G(INC)+$P(STRING,HLFS,I)
82DEBT ; debts
83 F I=13:1:15 S DEB=$G(DEB)+$P(STRING,HLFS,I)
84NET ; net worth
85 F I=16:1:19 I $P(STRING,HLFS,I)]"" S NET=$G(NET)+$P(STRING,HLFS,I)
86 I NET]"" S NET=NET-$P(STRING,HLFS,20)
87 Q INC_HLFS_DEB_HLFS_NET
88 ;
89 ;
90ADJ ; Adjust spouse dependent's strings
91 I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)'="^^" S SPOUSE=DEP
92 I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)="^^" K ARRAY(DEP) S DEP=DEP-1
93 I DEP S $P(ARRAY(DEP,"ZIC"),HLFS,21)=$$TOTAL(ARRAY(DEP,"ZIC"),ARRAY(DEP,"ZIR"),ARRAY(DEP,"ZDP"))
94 Q
Note: See TracBrowser for help on using the repository browser.