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 Apr 09, 2024@21:02:11 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
