Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMCME5

IVMCME5.m

Go to the documentation of this file.
  1. IVMCME5 ;ALB/SEK,KCL,BRM,AEG,BRM,TDM - CHECK INCOME TEST DATA (CON'T.) ; 1/9/03 3:51pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**17,26,38,49,58,62,67**;21-OCT-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. ; This routine is called from IVMCME4.
  1. ;
  1. MT(STRING,INCOME) ; Calculate means test status
  1. ;
  1. ; - init vars
  1. N X,Y,ADJ,HAR,INC,NET,THRESH,THRESHA,THRESHT,IVMTEXT,XMSUB,CAT,CAT1
  1. N THRESHG,THRESHV,EXP,NWC,DGMTICYR
  1. ;DGMTBS - BASE THRESHOLD VALUE FOR SITE
  1. ;DGMTBH - BASE THRESHOLD VALUE SENT FROM HEC
  1. ;DGTDEP - TOTAL # OF DEPENDENTS SENT BY HEC.
  1. N VADM,DGMTBS,DGMTBH,DGTDEP,ECODE,DGMTICY ;BRM added for IVM*2*26
  1. ;
  1. ; - perform initial error checking
  1. S CAT1=$P(STRING,HLFS,3)
  1. I '$$GETSTAT^DGMTH(CAT1,1) S ERROR="Invalid Means Test Status" G MTQ
  1. ;
  1. S CAT=$P(STRING,HLFS,26)
  1. ;
  1. I CAT="" S CAT=CAT1
  1. I CAT'="A",CAT'="C",CAT'="P",CAT'="G" S ERROR="Invalid Means Test Status for Test-Determined Status" G MTQ
  1. ;
  1. ; - if previous yr mt threshold flag is set use date of prev year
  1. 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)
  1. N Y S Y=$$HL7TFM^XLFDT(DGMTICY,"1D") X ^DD("DD") S DGMTICY=Y
  1. ;
  1. S %DT="" D ^%DT S X=Y K %DT
  1. ;
  1. S THRESH=$G(^DG(43,1,"MT",X,0)),THRESHT=$P(THRESH,U,2),DGMTBS=THRESHT
  1. 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)
  1. S DGMTICYR=$$LYR^DGMTSCU1($$HL7TFM^XLFDT($P(STRING,HLFS,2)))
  1. S THRESHV=$$GMTT(DFN,DGMTICYR,$G(DGTDEP))
  1. ;
  1. S INC=$P(STRING,HLFS,4)
  1. S EXP=$P(STRING,HLFS,9)
  1. S NET=$P(STRING,HLFS,5)
  1. S NWC=+$G(^DG(43,1,"GMT")) ; net worth calculation flag
  1. S ADJ=$P(STRING,HLFS,6)
  1. S THRESHA=$P(STRING,HLFS,8),DGMTBH=THRESHA
  1. S THRESHG=$P(STRING,HLFS,28)
  1. I $P(STRING,HLFS,12),(THRESHA'=THRESHT) S THRESHA=THRESHA+$P(THRESH,U,3)+(($P(STRING,HLFS,12)-1)*$P(THRESH,U,4))
  1. S DECLINE=$P(STRING,HLFS,16)
  1. S HAR=$P(STRING,HLFS,13)
  1. ;
  1. ; - perform error checking
  1. I DECLINE,((CAT="A")!(CAT="G")) S ERROR="Declines to give income info-must be MT Copay Required" G MTQ
  1. I DECLINE,CAT="C" G MTQ
  1. ;
  1. ; - if threshold A is incorrect, send message to sites's IVM MESSAGE
  1. ; mail group and continue to process
  1. I CAT'="G"&(THRESHT'=THRESHA) D
  1. .;
  1. .;brm;27apr00;code modifications below to add PID and Name to message
  1. .D:$G(DFN)'=""
  1. ..N VAHOW,VAROOT,VAPTYP
  1. ..D DEM^VADPT
  1. .S XMSUB="MT threshold discrepancy - "
  1. .S XMSUB=XMSUB_"PID - "_$P($G(VADM(2)),U,2)
  1. .S IVMTEXT(1)="While uploading the following income test from HEC a"
  1. .S IVMTEXT(2)="discrepancy was found with the threshold values."
  1. .S IVMTEXT(3)=" ",IVMTEXT(4)=" NAME: "_$G(VADM(1))
  1. .S IVMTEXT(5)=" ",IVMTEXT(6)=" PID : "_$P($G(VADM(2)),"^",2)
  1. .S IVMTEXT(8)=" ",IVMTEXT(9)="Date of Test sent from HEC: "_DGMTICY
  1. .S IVMTEXT(10)=" "
  1. .S IVMTEXT(11)="Site MT Threshold value: "_$J($FN($G(THRESHT),",",0),6)
  1. .S IVMTEXT(12)=" "
  1. .S IVMTEXT(13)="HEC Transmitted MT Threshold value: "_$J($FN($G(DGMTBH),",",0),6)
  1. .S IVMTEXT(14)=" ",IVMTEXT(16)="Total number of dependents: "_$G(DGTDEP)
  1. .S IVMTEXT(17)=" "
  1. .;brm;27apr00;end of changes
  1. .;
  1. .D MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
  1. .Q
  1. I (INC-EXP)'>THRESHA D I ERROR]"" G MTQ
  1. .I NET']"" S ERROR="This veteran requires net worth" Q
  1. .I ((NET-EXP)+$S(NWC:0,1:INC)'>$P(THRESH,U,8))&((CAT="C")!(CAT="G")) S ERROR="Income plus net worth not greater than threshold value-incorrect status" Q
  1. .I ((NET-EXP)+$S(NWC:0,1:INC)>$P(THRESH,U,8))&(CAT="A"),'$P(STRING,HLFS,6) S ERROR="Patient should be adjudicated-no adjudicated date/time" Q
  1. I (INC-EXP)>THRESHA,CAT'="C",'HAR,'ADJ,CAT'="P",CAT'="G" S ERROR="Incorrect means test status for Test-Determined Status"
  1. MTQ Q
  1. ;
  1. ;
  1. CO(STRING) ; Calculate copay test status
  1. ;
  1. ; - init vars
  1. N CAT,CAT1,COPDT,DECLINE,DEDEX,DEP,DGCAT,DGCOPS,DGCOST,INC
  1. ;
  1. ; - vars containing ZMT fields
  1. S COPDT=$$FMDATE^HLFNC($P(STRING,HLFS,2))
  1. S CAT1=$P(STRING,HLFS,3)
  1. I '$$GETSTAT^DGMTH(CAT1,2) S ERROR="Invalid Copay Test Status" G COQ
  1. ;
  1. ;For the Test-Determined Status only
  1. ; - a status of E or M or P should be transmitted
  1. ; - P only is networth is used to determine exemption
  1. S CAT=$P(STRING,HLFS,26)
  1. I CAT="" S CAT=CAT1
  1. I CAT'="E",CAT'="M",CAT'="P" S ERROR="Invalid Copay Test Status for Test-Determined Status" G COQ
  1. I CAT="P",'$$NETW^IBARXEU1 S ERROR="Invalid Copay Test Status for Test-Determined Status" G COQ
  1. ;
  1. ; - a status of E or M or P should be transmitted
  1. ; - P only is networth is used to determine exemption
  1. I CAT'="E",CAT'="M",CAT'="P" S ERROR="Invalid Copay Test Status" G COQ
  1. I CAT="P",'$$NETW^IBARXEU1 S ERROR="Invalid Copay Test Status" G COQ
  1. S INC=$P(STRING,HLFS,4)
  1. S DEDEX=$P(STRING,HLFS,9)
  1. S DEP=$P(STRING,HLFS,12)
  1. S DECLINE=$P(STRING,HLFS,16)
  1. ;
  1. S DGCOST=COPDT_U_DFN_U_U_INC,$P(DGCOST,U,14)=DECLINE,$P(DGCOST,U,15)=DEDEX,$P(DGCOST,U,18)=DEP,$P(DGCOST,U,19)=2
  1. S DGCOPS=$$INCDT^IBARXEU1(DGCOST)
  1. S DGCAT=$S(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
  1. I CAT'=DGCAT S ERROR="Copay Test Status should be "_DGCAT
  1. COQ Q
  1. ;
  1. ;
  1. INC ; Gather income totals
  1. N DEBD,DEB,DEBT,DGX,EXCL,INC,INCYR,NET,X,Y
  1. I $P(STRING,HLFS,4)']"",'$$IS^IVMCUC(DFN,DGLY),'$P(STRING,HLFS,16) S ERROR="No Income transmitted"
  1. S INC=$P(ARRAY("ZIC"),HLFS,21),DEBT=$P(ARRAY("ZIC"),HLFS,22),NET=$P(ARRAY("ZIC"),HLFS,23)
  1. S DGX=0 F S DGX=$O(ARRAY(DGX)) Q:'DGX D
  1. .S INC=INC+($P(ARRAY(DGX,"ZIC"),HLFS,21))
  1. .S NET=NET+($P(ARRAY(DGX,"ZIC"),HLFS,23))
  1. .I $P(ARRAY(DGX,"ZDP"),U,6)'=2 D Q
  1. ..S X=$E($P(ARRAY("ZMT"),U,2),1,4),%DT="" D ^%DT S INCYR=Y
  1. ..S EXCL=$P($G(^DG(43,1,"MT",INCYR,0)),U,17)
  1. ..S DEBD=($P(ARRAY(DGX,"ZIC"),HLFS,9)-EXCL-$P(ARRAY(DGX,"ZIC"),HLFS,15))
  1. ..S DEBD=$S(DEBD>0:DEBD,1:0)
  1. ..S DEB=($P(ARRAY(DGX,"ZIC"),HLFS,9)-DEBD)
  1. ..S DEBT=DEBT+DEB
  1. .S DEBT=DEBT+($P(ARRAY(DGX,"ZIC"),HLFS,22))
  1. INCQ Q
  1. ;
  1. ;
  1. SIGN ; Date Veteran Signed/Refused to Sign
  1. I $P(STRING,HLFS,15)]"" D G:ERROR]"" SIGNQ
  1. .S X=$P(STRING,HLFS,15) I $E(X,1,4)<1994!($E(X,1,4)>($E(DT,1,3)+1700)) S ERROR="Invalid Date Veteran Signed Test" Q
  1. .S X=$$FMDATE^HLFNC($P(STRING,HLFS,15)),%DT="X" D ^%DT I Y<0 S ERROR="Invalid Date Veteran Signed Test" Q
  1. SIGNQ Q
  1. ;
  1. LTC(STRING) ;calculate LTC test status
  1. ;
  1. N CAT1
  1. S CAT1=$P(STRING,HLFS,3)
  1. I '$$GETSTAT^DGMTH(CAT1,4) S ERROR="Invalid LTC Test Status"
  1. Q
  1. ;
  1. GMTT(DFN,DGMTICY,DGTDEP) ;Get GMT Threshold values for veteran
  1. ; Input: DFN = Patient IEN
  1. ; DGMTICY = Last Income year
  1. ; DGTDEP = Total number of dependents
  1. ;Output: GMTT = GMT Thresholds for Veteran
  1. ;
  1. N DGMTGMT,GMT,GMTT,PCT
  1. S GMTT=0
  1. D GETFIPS^EASAILK(DFN,DGMTICY,.GMT)
  1. I '$G(GMT("GMTIEN")) Q GMTT
  1. S DGMTGMT=$G(^EAS(712.5,GMT("GMTIEN"),1))
  1. I (DGTDEP+1)<9 S GMTT=$P(DGMTGMT,"^",(DGTDEP+1)) Q GMTT
  1. S PCT=((DGTDEP+1)-8)*8+132,GMTT=$P(DGMTGMT,"^",4)*PCT/100
  1. S GMTT=$S(GMTT#50=0:GMTT,1:GMTT+(50-(GMTT#50)))
  1. Q GMTT