source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCMF3.m@ 649

Last change on this file since 649 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1IVMCMF3 ;ALB/RMM - CHECK INCOME TEST DATA (CON'T.) ; 01/02/03
2 ;;2.0;INCOME VERIFICATION MATCH;**71,107**;21-OCT-94
3 ;
4 ;
5 ; This routine is called from IVMCMF2.
6 ;
7MT(STRING,INCOME) ; Calculate means test status
8 ; DGMTBS - BASE THRESHOLD VALUE FOR SITE
9 ; DGMTBH - BASE THRESHOLD VALUE SENT FROM HEC
10 ; DGTDEP - TOTAL # OF DEPENDENTS SENT BY HEC.
11 ;
12 N X,Y,ADJ,HAR,INC,NET,THRESH,THRESHA,THRESHT,IVMTEXT,XMSUB,CAT,CAT1
13 N VADM,DGMTBS,DGMTBH,DGTDEP,DGMTICY,DGMTCMP,DECLINE,DGMTICYR
14 S CAT1=$P(STRING,HLFS,3),CAT=$P(STRING,HLFS,26) I CAT="" S CAT=CAT1
15 ;
16 ; If previous yr mt threshold flag is set use date of prev year
17 S X=$S($P(STRING,HLFS,11):($E($P(STRING,HLFS,2),1,4)-1),1:$E($P(STRING,HLFS,2),1,4)),DGMTICY=$P($G(STRING),HLFS,2)
18 N Y S Y=$$HL7TFM^XLFDT(DGMTICY,"1D") X ^DD("DD") S DGMTICY=Y
19 S %DT="" D ^%DT S X=Y K %DT
20 S THRESH=$G(^DG(43,1,"MT",X,0)),THRESHT=$P(THRESH,U,2),DGMTBS=THRESHT
21 I $P(STRING,HLFS,12) S THRESHT=THRESHT+$P(THRESH,U,3)+(($P(STRING,HLFS,12)-1)*$P(THRESH,U,4)),DGTDEP=$P($G(STRING),HLFS,12)
22 ;
23 S INC=$P(STRING,HLFS,4)-$P(STRING,HLFS,9),NET=$P(STRING,HLFS,5)
24 S ADJ=$P(STRING,HLFS,6),THRESHA=$P(STRING,HLFS,8),DGMTBH=THRESHA
25 I $P(STRING,HLFS,12),(THRESHA'=THRESHT) S THRESHA=THRESHA+$P(THRESH,U,3)+(($P(STRING,HLFS,12)-1)*$P(THRESH,U,4))
26 S DECLINE=$P(STRING,HLFS,16),HAR=$P(STRING,HLFS,13),DGMTCMP=+$P(STRING,HLFS,10)
27 S DGMTICYR=$$LYR^DGMTSCU1($$HL7TFM^XLFDT($P(STRING,HLFS,2)))
28 ;
29 ; If Decline to Give Incone Info & MT CP Req, Quit
30 I DECLINE,CAT="C" G MTQ
31 ;
32 ; If threshold A is incorrect, send message to sites's IVM MESSAGE
33 ; mail group and continue to process
34 I +DGMTBH>0,DGMTCMP>0,(CAT'="G"&(THRESHT'=THRESHA)) D
35 .D:$G(DFN)'=""
36 ..N VAHOW,VAROOT,VAPTYP
37 ..D DEM^VADPT
38 .S XMSUB="MT threshold discrepancy - "_"PID - "_$P($G(VADM(2)),U,2)
39 .S IVMTEXT(1)="While uploading the following income test from HEC a"
40 .S IVMTEXT(2)="discrepancy was found with the threshold A values."
41 .S IVMTEXT(3)=" ",IVMTEXT(4)=" NAME: "_$G(VADM(1))
42 .S IVMTEXT(5)=" ",IVMTEXT(6)=" PID : "_$P($G(VADM(2)),"^",2)
43 .S IVMTEXT(8)=" ",IVMTEXT(9)="Date of Test sent from HEC: "_DGMTICY
44 .S IVMTEXT(10)=" "
45 .S IVMTEXT(11)="Site MT Threshold value: "_$J($FN($G(THRESHT),",",0),6)
46 .S IVMTEXT(12)=" "
47 .S IVMTEXT(13)="HEC Transmitted MT Threshold value: "_$J($FN($G(DGMTBH),",",0),6)
48 .S IVMTEXT(14)=" ",IVMTEXT(16)="Total number of dependents: "_$G(DGTDEP)
49 .S IVMTEXT(17)=" "
50 .D MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
51 .Q
52 ;
53 I INC'>THRESHA I ((INC+NET)'>$P(THRESH,U,8))&(CAT="C") S CNT=CNT+1,IVMERR(CNT)="Income plus net worth not greater than threshold value-incorrect status"
54 I INC>THRESHA,CAT'="C",'HAR,'ADJ,CAT'="P" S CNT=CNT+1,IVMERR(CNT)="Incorrect means test status for Test-Determined Status"
55MTQ Q
56 ;
57 ;
58CO(STRING) ; Calculate copay test status
59 ;
60 ; Variables containing ZMT fields
61 N CAT,CAT1,DGCAT,DGCOPS,DGCOST
62 S CAT1=$P(STRING,HLFS,3),CAT=$P(STRING,HLFS,26) I CAT="" S CAT=CAT1
63 S DGCOST=$$FMDATE^HLFNC($P(STRING,HLFS,2))_U_DFN_U_U_$P(STRING,HLFS,4)_U_U_U_U_U_U_U_U_U_U_$P(STRING,HLFS,16)_U_$P(STRING,HLFS,9)_U_U_U_$P(STRING,HLFS,12)_U_2
64 S DGCOPS=$$INCDT^IBARXEU1(DGCOST),DGCAT=$S(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
65 I CAT'=DGCAT S CNT=CNT+1,IVMERR(CNT)="Copay Test Status should be "_DGCAT
66COQ Q
Note: See TracBrowser for help on using the repository browser.