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