DGMTARR.m

DGMTARR ;ALB/GRR/PHH - PRINT ROUTINES FOR MEANS TEST VERIFICATION; JAN 21, 1999

 ;;5.3;Registration;**217,535,1015**;AUG 13, 1993;Build 21

 ;DGLOW - LOW DOLLAR AMOUNT RANGE

 ;DGHIGH - HIGH DOLLAR AMOUNT RANGE

 ;DGSDAT - START DATE RANGE

 ;DGTDAT - END DATE RANGE

 ;DGINC - PATIENT INCOME AMOUNT

 ;DGTHR - PATIENT THRESHOLD AMOUNT

 ;DGNAME - PATIENT NAME

 ;DGDIFF - AMOUNT OF DIFFERENCE BETWEEN INCOME AND THRESHOLD

 ;DGVISN - VISN NUMBER

 ;DGVAMC - VAMC NUMBER

 ;

ENSDA ;ENTRY FOR REPORT OF VETERANS WITH SPECIFIC INCOME DOLLAR AMOUNT

 N DFN,SEX,DGLOW,DGHIGH,DGFDOL,DGTDOL,DGSDAT,DGTDAT

 W !!,"Veterans with Income of a Specified Dollar Amount"

 S DGLOW=0,DGHIGH=99999

 S Y=$$DOLRAN(DGLOW,DGHIGH) Q:Y<0

 S DGFDOL=$P(Y,"^"),DGTDOL=$P(Y,"^",2)

 S Y=$$DATRAN() Q:'Y

 S DGSDAT=$P(Y,"^"),DGTDAT=$P(Y,"^",2)

 F X="DGFDOL","DGTDOL","DGSDAT","DGTDAT" S ZTSAVE(X)=""

 D EN^XUTMDEVQ("RPTSDA^DGMTARR","MT Specific Income Report",.ZTSAVE)

 D HOME^%ZIS

 Q

RPTSDA ;ENTRY POINT FROM XUTMDEVQ

 N DFN,SEX,VADM,DGDAT,DGIEN,DGMT0,DGINC,DGNAME,SSN,DGMTDATE,DGPMDT,DGPVISN,DGPVAMC,Y,VAERR,VA,DGPDG,DGPHDOL,DGPLDOL,DGPSDAT,DGPTDAT,DGPVASN

 D DFORM(DGSDAT,DGTDAT,DGFDOL,DGTDOL)

 K ^TMP($J,"MTSPI")

 S DGDAT=DGSDAT-1 F  S DGDAT=$O(^DGMT(408.31,"AG",DGDAT)) Q:DGDAT'>0!(DGDAT\1>DGTDAT)  S DGIEN=0 F  S DGIEN=$O(^DGMT(408.31,"AG",DGDAT,DGIEN)) Q:DGIEN'>0  D

 .S DGMT0=$G(^DGMT(408.31,DGIEN,0))

 .S DGINC=$P(DGMT0,"^",4) Q:DGINC=""

 .Q:$P(DGMT0,"^",19)'=1

 .I DGINC'<DGFDOL&(DGINC'>DGTDOL) D

 ..S DFN=$P(DGMT0,"^",2) D DEM^VADPT Q:$G(VADM(6))]""  S DGNAME=$G(VADM(1)),SSN=$P($G(VADM(2)),"^",2)

 ..S ^TMP($J,"MTSPI",DGINC,DGNAME,DFN)=SSN_"^"_DGDAT

 I $E(IOST,1,2)="C-" W @IOF

 D NOFF

 I $O(^TMP($J,"MTSPI",-1))="" W !,"NO MATCHING PATIENTS FOUND!",@IOF G RPTSDAQ

 S DGINC=-1 F  S DGINC=$O(^TMP($J,"MTSPI",DGINC)) Q:DGINC=""  D  Q:$D(DTOUT)!($D(DUOUT))

 .S DGNAME="" W ! F  S DGNAME=$O(^TMP($J,"MTSPI",DGINC,DGNAME)) Q:DGNAME=""  S DFN=0 F  S DFN=$O(^TMP($J,"MTSPI",DGINC,DGNAME,DFN)) Q:DFN=""  D  Q:$D(DTOUT)!($D(DUOUT))

 ..S SSN=$P(^TMP($J,"MTSPI",DGINC,DGNAME,DFN),"^"),DGMTDATE=$P(^(DFN),"^",2),Y=DGMTDATE D DD^%DT S DGPMDT=Y

 ..I $Y+2>IOSL D  Q:$D(DTOUT)!($D(DUOUT))

 ...I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))

 ...D HED

 ..W !,DGNAME,?32,SSN,?53-$L(DGINC),DGINC,?60,DGPMDT

 W !

RPTSDAQ ;EXIT POINT FOR SPECIFIC INCOME REPORT

 K ^TMP($J,"MTSPI"),DGSDAT,DGTDAT,Y Q

DATRAN() ;ASK DATE RANGE

 N DGFDAT,DGTDAT

 D DT^DICRW

 S DIR(0)="D^2990101:"_DT_":EX",DIR("A")="Enter From Date" D ^DIR K DIR

 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 0

 S DGFDAT=Y\1

 S DIR(0)="D^"_DGFDAT_":"_DT_":EX",DIR("A")="Enter To Date" D ^DIR K DIR

 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 0

 S DGTDAT=Y

 Q DGFDAT_"^"_DGTDAT

DOLRAN(DGLOW,DGHIGH) ;ASK DOLLAR RANGE

 N DGLDOL,DGHDOL,Y

 S DIR(0)="N^"_DGLOW_":"_DGHIGH_":2",DIR("A")="Enter Low Dollar Amount" D ^DIR K DIR

 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) -1

 S DGLDOL=Y

 S DIR(0)="N^"_DGLDOL_":"_DGHIGH_":2",DIR("A")="Enter High Dollar Amount" D ^DIR K DIR

 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) -1

 S DGHDOL=Y

 Q DGLDOL_"^"_DGHDOL

HED ;PRINT HEADER

 W @IOF

NOFF ;SKIP FORM FEED

 S Y=$$GETVV(),DGPVAMC=$P(Y,"^"),DGPVISN=$P(Y,"^",3),DGPVASN=$P(Y,"^",2)

 W !,?25,"VETERANS WITH INCOME - $",DGPLDOL," - $",DGPHDOL

 W !,?20,"DETAILED REPORT   ",DGPSDAT," - ",DGPTDAT

 W !,?26,"DATE PRINTED - ",DGPDG

 W !!,"VISN: ",DGPVISN," - VAMC: ",DGPVAMC," (",DGPVASN,")"

 W !!,"NAME",?32,"SSN",?45,"$ AMOUNT",?60,"MT COMPLETED",!

 Q

 ;

ENLTT ;CREATE AND PRINT VETERANS WITH INCOME LESS THAN THRESHOLD

 N DGLOW,DGHIGH,DGLDOL,DGHDOL,DGSDAT,DGTDAT

 W !!,"Veterans with Income Less than MT Threshold"

 S DGLOW=0,DGHIGH=99999

 S Y=$$DOLRAN(DGLOW,DGHIGH) Q:Y<0

 S DGFDOL=$P(Y,"^"),DGTDOL=$P(Y,"^",2)

 S Y=$$DATRAN() Q:Y<0

 S DGSDAT=$P(Y,"^"),DGTDAT=$P(Y,"^",2)

 F X="DGFDOL","DGTDOL","DGSDAT","DGTDAT" S ZTSAVE(X)=""

 D EN^XUTMDEVQ("RPTLTT^DGMTARR","MT less than threshold report",.ZTSAVE)

 D HOME^%ZIS

 Q

RPTLTT ;BUILD AND PRINT LESS THAN THRESHOLD REPORT.  ENTRY POINT FROM XUTMDEVQ

 N DGDAT,DFN,SEX,DGIEN,DGINC,DGTHR,DGLDOL,DGHDOL,VADM,SSN,DGPVISN,DGPVAMC,DGDIFF,DGMT0,DGNAME,DGPDG,DGPHDOL,DGPLDOL,DGPMDT,DGPSDAT,DGPTDAT,DGPVASN

 D DFORM(DGSDAT,DGTDAT,DGFDOL,DGTDOL)

 K ^TMP($J,"MTLTT")

 S DGDAT=DGSDAT-1 F  S DGDAT=$O(^DGMT(408.31,"AG",DGDAT)) Q:DGDAT'>0!(DGDAT\1>DGTDAT)  S DGIEN=0 F  S DGIEN=$O(^DGMT(408.31,"AG",DGDAT,DGIEN)) Q:DGIEN'>0  D

 .S DGMT0=$G(^DGMT(408.31,DGIEN,0))

 .S DGINC=$P(DGMT0,"^",4),DGTHR=+$P(DGMT0,"^",12) Q:DGINC=""

 .Q:$P(DGMT0,"^",19)'=1

 .Q:DGINC>DGTHR

 .S DGDIFF=DGTHR-DGINC

 .I DGDIFF'<DGFDOL&(DGDIFF'>DGTDOL) D

 ..S DFN=$P(DGMT0,"^",2) D DEM^VADPT Q:$G(VADM(6))]""  S DGNAME=$G(VADM(1)),SSN=$P($G(VADM(2)),"^",2)

 ..S ^TMP($J,"MTLTT",DGTHR,DGINC,DGNAME,DFN)=SSN_"^"_DGDAT

 I $E(IOST,1,2)="C-" W @IOF

 D NOFF2

 I $O(^TMP($J,"MTLTT",-1))'>0 W !,"NO MATCHING PATIENTS FOUND!",@IOF G RPTLTTQ

 S DGTHR=-1 F  S DGTHR=$O(^TMP($J,"MTLTT",DGTHR)) Q:DGTHR=""  D  Q:$D(DTOUT)!($D(DUOUT))

 .S DGINC=-1 W !

 .F  S DGINC=$O(^TMP($J,"MTLTT",DGTHR,DGINC)) Q:DGINC=""  S DGNAME="" F  S DGNAME=$O(^TMP($J,"MTLTT",DGTHR,DGINC,DGNAME)) Q:DGNAME=""  S DFN=0 F  S DFN=$O(^TMP($J,"MTLTT",DGTHR,DGINC,DGNAME,DFN)) Q:DFN=""  D  Q:$D(DTOUT)!($D(DUOUT))

 ..S SSN=$P(^TMP($J,"MTLTT",DGTHR,DGINC,DGNAME,DFN),"^"),DGDAT=$P(^(DFN),"^",2),Y=DGDAT D DD^%DT S DGPMDT=$S(Y["@":$P(Y,"@"),1:Y)

 ..I $Y+2>IOSL D  Q:$D(DTOUT)!($D(DUOUT))

 ...I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))

 ...D HED2

 ..W !,DGNAME,?32,SSN,?53-$L($J(DGINC,7,2)),$J(DGINC,7,2),?57,DGTHR,?65,DGPMDT

 W !

RPTLTTQ ;EXIT POINT FOR LESS THAN THRESHOLD REPORT

 K ^TMP($J,"MTLTT"),Y,VA,VAERR,DGFDOL,DGTDOL Q

DFORM(DGSDAT,DGTDAT,DGLDOL,DGHDOL) ;

 D DT^DICRW S Y=DT D DD^%DT S DGPDG=Y

 S Y=DGSDAT D DD^%DT S DGPSDAT=Y

 S Y=DGTDAT D DD^%DT S DGPTDAT=Y

 S DGPLDOL=$S($P(DGLDOL,".",2)="":DGLDOL_".00",1:DGLDOL)

 S DGPHDOL=$S($P(DGHDOL,".",2)="":DGHDOL_".00",1:DGHDOL)

 Q

HED2 ;

 W @IOF

NOFF2 ;SKIP FORM FEED

 S Y=$$GETVV(),DGPVAMC=$P(Y,"^"),DGPVISN=$P(Y,"^",3),DGPVASN=$P(Y,"^",2)

 W !,?12,"VETERANS WITH INCOME - $",DGPLDOL," - $",DGPHDOL," LESS THAN MT THRESHOLD"

 W !,?20,"DETAILED REPORT  ",DGPSDAT," - ",DGPTDAT

 W !,?26,"DATE PRINTED - ",DGPDG

 W !!,"VISN: ",DGPVISN," - VAMC: ",DGPVAMC," (",DGPVASN,")"

 W !!,?47,"INCOME"

 W !,"NAME",?32,"SSN",?47,"$ AMT.",?55,"THRESHOLD",?65,"MT COMPLETED"

 Q

GETVV() ;GET VISN AND VAMC

 N Z,DGVISN,DGVAMCNA,DGVAMCSN

 Q:$G(DUZ(2))="" ""

 S Z=$$NS^XUAF4(DUZ(2))

 S DGVAMCNA=$P(Z,"^"),DGVAMCSN=$P(Z,"^",2)

 D PARENT^XUAF4("DGVISN","`"_DUZ(2),"VISN") I $D(DGVISN) S J=$O(DGVISN("P",0)) S $P(Z,"^",3)=$P($G(DGVISN("P",J)),"^")

 Q Z

DGMTARR   ;ALB/GRR/PHH - PRINT ROUTINES FOR MEANS TEST VERIFICATION; JAN 21, 1999

 +1       ;;5.3;Registration;**217,535,1015**;AUG 13, 1993;Build 21

 +2       ;DGLOW - LOW DOLLAR AMOUNT RANGE

 +3       ;DGHIGH - HIGH DOLLAR AMOUNT RANGE

 +4       ;DGSDAT - START DATE RANGE

 +5       ;DGTDAT - END DATE RANGE

 +6       ;DGINC - PATIENT INCOME AMOUNT

 +7       ;DGTHR - PATIENT THRESHOLD AMOUNT

 +8       ;DGNAME - PATIENT NAME

 +9       ;DGDIFF - AMOUNT OF DIFFERENCE BETWEEN INCOME AND THRESHOLD

 +10      ;DGVISN - VISN NUMBER

 +11      ;DGVAMC - VAMC NUMBER

 +12      ;

ENSDA     ;ENTRY FOR REPORT OF VETERANS WITH SPECIFIC INCOME DOLLAR AMOUNT

 +1        NEW DFN,SEX,DGLOW,DGHIGH,DGFDOL,DGTDOL,DGSDAT,DGTDAT

 +2        WRITE !!,"Veterans with Income of a Specified Dollar Amount"

 +3        SET DGLOW=0

           SET DGHIGH=99999

 +4        SET Y=$$DOLRAN(DGLOW,DGHIGH)

           IF Y<0

               QUIT 

 +5        SET DGFDOL=$PIECE(Y,"^")

           SET DGTDOL=$PIECE(Y,"^",2)

 +6        SET Y=$$DATRAN()

           IF 'Y

               QUIT 

 +7        SET DGSDAT=$PIECE(Y,"^")

           SET DGTDAT=$PIECE(Y,"^",2)

 +8        FOR X="DGFDOL","DGTDOL","DGSDAT","DGTDAT"

               SET ZTSAVE(X)=""

 +9        DO EN^XUTMDEVQ("RPTSDA^DGMTARR","MT Specific Income Report",.ZTSAVE)

 +10       DO HOME^%ZIS

 +11       QUIT 

RPTSDA    ;ENTRY POINT FROM XUTMDEVQ

 +1        NEW DFN,SEX,VADM,DGDAT,DGIEN,DGMT0,DGINC,DGNAME,SSN,DGMTDATE,DGPMDT,DGPVISN,DGPVAMC,Y,VAERR,VA,DGPDG,DGPHDOL,DGPLDOL,DGPSDAT,DGPTDAT,DGPVASN

 +2        DO DFORM(DGSDAT,DGTDAT,DGFDOL,DGTDOL)

 +3        KILL ^TMP($JOB,"MTSPI")

 +4        SET DGDAT=DGSDAT-1

           FOR 

               SET DGDAT=$ORDER(^DGMT(408.31,"AG",DGDAT))

               IF DGDAT'>0!(DGDAT\1>DGTDAT)

                   QUIT 

               SET DGIEN=0

               FOR 

                   SET DGIEN=$ORDER(^DGMT(408.31,"AG",DGDAT,DGIEN))

                   IF DGIEN'>0

                       QUIT 

                   Begin DoDot:1

 +5                    SET DGMT0=$GET(^DGMT(408.31,DGIEN,0))

 +6                    SET DGINC=$PIECE(DGMT0,"^",4)

                       IF DGINC=""

                           QUIT 

 +7                    IF $PIECE(DGMT0,"^",19)'=1

                           QUIT 

 +8                    IF DGINC'<DGFDOL&(DGINC'>DGTDOL)

                           Begin DoDot:2

 +9                            SET DFN=$PIECE(DGMT0,"^",2)

                               DO DEM^VADPT

                               IF $GET(VADM(6))]""

                                   QUIT 

                               SET DGNAME=$GET(VADM(1))

                               SET SSN=$PIECE($GET(VADM(2)),"^",2)

 +10                           SET ^TMP($JOB,"MTSPI",DGINC,DGNAME,DFN)=SSN_"^"_DGDAT

                           End DoDot:2

                   End DoDot:1

 +11       IF $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

 +12       DO NOFF

 +13       IF $ORDER(^TMP($JOB,"MTSPI",-1))=""

               WRITE !,"NO MATCHING PATIENTS FOUND!",@IOF

               GOTO RPTSDAQ

 +14       SET DGINC=-1

           FOR 

               SET DGINC=$ORDER(^TMP($JOB,"MTSPI",DGINC))

               IF DGINC=""

                   QUIT 

               Begin DoDot:1

 +15               SET DGNAME=""

                   WRITE !

                   FOR 

                       SET DGNAME=$ORDER(^TMP($JOB,"MTSPI",DGINC,DGNAME))

                       IF DGNAME=""

                           QUIT 

                       SET DFN=0

                       FOR 

                           SET DFN=$ORDER(^TMP($JOB,"MTSPI",DGINC,DGNAME,DFN))

                           IF DFN=""

                               QUIT 

                           Begin DoDot:2

 +16                           SET SSN=$PIECE(^TMP($JOB,"MTSPI",DGINC,DGNAME,DFN),"^")

                               SET DGMTDATE=$PIECE(^(DFN),"^",2)

                               SET Y=DGMTDATE

                               DO DD^%DT

                               SET DGPMDT=Y

 +17                           IF $Y+2>IOSL

                                   Begin DoDot:3

 +18                                   IF $EXTRACT(IOST,1,2)="C-"

                                           SET DIR(0)="E"

                                           DO ^DIR

                                           KILL DIR

                                           IF $DATA(DTOUT)!($DATA(DUOUT))

                                               QUIT 

 +19                                   DO HED

                                   End DoDot:3

                                   IF $DATA(DTOUT)!($DATA(DUOUT))

                                       QUIT 

 +20                           WRITE !,DGNAME,?32,SSN,?53-$LENGTH(DGINC),DGINC,?60,DGPMDT

                           End DoDot:2

                           IF $DATA(DTOUT)!($DATA(DUOUT))

                               QUIT 

               End DoDot:1

               IF $DATA(DTOUT)!($DATA(DUOUT))

                   QUIT 

 +21       WRITE !

RPTSDAQ   ;EXIT POINT FOR SPECIFIC INCOME REPORT

 +1        KILL ^TMP($JOB,"MTSPI"),DGSDAT,DGTDAT,Y

           QUIT 

DATRAN()  ;ASK DATE RANGE

 +1        NEW DGFDAT,DGTDAT

 +2        DO DT^DICRW

 +3        SET DIR(0)="D^2990101:"_DT_":EX"

           SET DIR("A")="Enter From Date"

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               QUIT 0

 +5        SET DGFDAT=Y\1

 +6        SET DIR(0)="D^"_DGFDAT_":"_DT_":EX"

           SET DIR("A")="Enter To Date"

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               QUIT 0

 +8        SET DGTDAT=Y

 +9        QUIT DGFDAT_"^"_DGTDAT

DOLRAN(DGLOW,DGHIGH) ;ASK DOLLAR RANGE

 +1        NEW DGLDOL,DGHDOL,Y

 +2        SET DIR(0)="N^"_DGLOW_":"_DGHIGH_":2"

           SET DIR("A")="Enter Low Dollar Amount"

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               QUIT -1

 +4        SET DGLDOL=Y

 +5        SET DIR(0)="N^"_DGLDOL_":"_DGHIGH_":2"

           SET DIR("A")="Enter High Dollar Amount"

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               QUIT -1

 +7        SET DGHDOL=Y

 +8        QUIT DGLDOL_"^"_DGHDOL

HED       ;PRINT HEADER

 +1        WRITE @IOF

NOFF      ;SKIP FORM FEED

 +1        SET Y=$$GETVV()

           SET DGPVAMC=$PIECE(Y,"^")

           SET DGPVISN=$PIECE(Y,"^",3)

           SET DGPVASN=$PIECE(Y,"^",2)

 +2        WRITE !,?25,"VETERANS WITH INCOME - $",DGPLDOL," - $",DGPHDOL

 +3        WRITE !,?20,"DETAILED REPORT   ",DGPSDAT," - ",DGPTDAT

 +4        WRITE !,?26,"DATE PRINTED - ",DGPDG

 +5        WRITE !!,"VISN: ",DGPVISN," - VAMC: ",DGPVAMC," (",DGPVASN,")"

 +6        WRITE !!,"NAME",?32,"SSN",?45,"$ AMOUNT",?60,"MT COMPLETED",!

 +7        QUIT 

 +8       ;

ENLTT     ;CREATE AND PRINT VETERANS WITH INCOME LESS THAN THRESHOLD

 +1        NEW DGLOW,DGHIGH,DGLDOL,DGHDOL,DGSDAT,DGTDAT

 +2        WRITE !!,"Veterans with Income Less than MT Threshold"

 +3        SET DGLOW=0

           SET DGHIGH=99999

 +4        SET Y=$$DOLRAN(DGLOW,DGHIGH)

           IF Y<0

               QUIT 

 +5        SET DGFDOL=$PIECE(Y,"^")

           SET DGTDOL=$PIECE(Y,"^",2)

 +6        SET Y=$$DATRAN()

           IF Y<0

               QUIT 

 +7        SET DGSDAT=$PIECE(Y,"^")

           SET DGTDAT=$PIECE(Y,"^",2)

 +8        FOR X="DGFDOL","DGTDOL","DGSDAT","DGTDAT"

               SET ZTSAVE(X)=""

 +9        DO EN^XUTMDEVQ("RPTLTT^DGMTARR","MT less than threshold report",.ZTSAVE)

 +10       DO HOME^%ZIS

 +11       QUIT 

RPTLTT    ;BUILD AND PRINT LESS THAN THRESHOLD REPORT.  ENTRY POINT FROM XUTMDEVQ

 +1        NEW DGDAT,DFN,SEX,DGIEN,DGINC,DGTHR,DGLDOL,DGHDOL,VADM,SSN,DGPVISN,DGPVAMC,DGDIFF,DGMT0,DGNAME,DGPDG,DGPHDOL,DGPLDOL,DGPMDT,DGPSDAT,DGPTDAT,DGPVASN

 +2        DO DFORM(DGSDAT,DGTDAT,DGFDOL,DGTDOL)

 +3        KILL ^TMP($JOB,"MTLTT")

 +4        SET DGDAT=DGSDAT-1

           FOR 

               SET DGDAT=$ORDER(^DGMT(408.31,"AG",DGDAT))

               IF DGDAT'>0!(DGDAT\1>DGTDAT)

                   QUIT 

               SET DGIEN=0

               FOR 

                   SET DGIEN=$ORDER(^DGMT(408.31,"AG",DGDAT,DGIEN))

                   IF DGIEN'>0

                       QUIT 

                   Begin DoDot:1

 +5                    SET DGMT0=$GET(^DGMT(408.31,DGIEN,0))

 +6                    SET DGINC=$PIECE(DGMT0,"^",4)

                       SET DGTHR=+$PIECE(DGMT0,"^",12)

                       IF DGINC=""

                           QUIT 

 +7                    IF $PIECE(DGMT0,"^",19)'=1

                           QUIT 

 +8                    IF DGINC>DGTHR

                           QUIT 

 +9                    SET DGDIFF=DGTHR-DGINC

 +10                   IF DGDIFF'<DGFDOL&(DGDIFF'>DGTDOL)

                           Begin DoDot:2

 +11                           SET DFN=$PIECE(DGMT0,"^",2)

                               DO DEM^VADPT

                               IF $GET(VADM(6))]""

                                   QUIT 

                               SET DGNAME=$GET(VADM(1))

                               SET SSN=$PIECE($GET(VADM(2)),"^",2)

 +12                           SET ^TMP($JOB,"MTLTT",DGTHR,DGINC,DGNAME,DFN)=SSN_"^"_DGDAT

                           End DoDot:2

                   End DoDot:1

 +13       IF $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

 +14       DO NOFF2

 +15       IF $ORDER(^TMP($JOB,"MTLTT",-1))'>0

               WRITE !,"NO MATCHING PATIENTS FOUND!",@IOF

               GOTO RPTLTTQ

 +16       SET DGTHR=-1

           FOR 

               SET DGTHR=$ORDER(^TMP($JOB,"MTLTT",DGTHR))

               IF DGTHR=""

                   QUIT 

               Begin DoDot:1

 +17               SET DGINC=-1

                   WRITE !

 +18               FOR 

                       SET DGINC=$ORDER(^TMP($JOB,"MTLTT",DGTHR,DGINC))

                       IF DGINC=""

                           QUIT 

                       SET DGNAME=""

                       FOR 

                           SET DGNAME=$ORDER(^TMP($JOB,"MTLTT",DGTHR,DGINC,DGNAME))

                           IF DGNAME=""

                               QUIT 

                           SET DFN=0

                           FOR 

                               SET DFN=$ORDER(^TMP($JOB,"MTLTT",DGTHR,DGINC,DGNAME,DFN))

                               IF DFN=""

                                   QUIT 

                               Begin DoDot:2

 +19                               SET SSN=$PIECE(^TMP($JOB,"MTLTT",DGTHR,DGINC,DGNAME,DFN),"^")

                                   SET DGDAT=$PIECE(^(DFN),"^",2)

                                   SET Y=DGDAT

                                   DO DD^%DT

                                   SET DGPMDT=$SELECT(Y["@":$PIECE(Y,"@"),1:Y)

 +20                               IF $Y+2>IOSL

                                       Begin DoDot:3

 +21                                       IF $EXTRACT(IOST,1,2)="C-"

                                               SET DIR(0)="E"

                                               DO ^DIR

                                               KILL DIR

                                               IF $DATA(DTOUT)!($DATA(DUOUT))

                                                   QUIT 

 +22                                       DO HED2

                                       End DoDot:3

                                       IF $DATA(DTOUT)!($DATA(DUOUT))

                                           QUIT 

 +23                               WRITE !,DGNAME,?32,SSN,?53-$LENGTH($JUSTIFY(DGINC,7,2)),$JUSTIFY(DGINC,7,2),?57,DGTHR,?65,DGPMDT

                               End DoDot:2

                               IF $DATA(DTOUT)!($DATA(DUOUT))

                                   QUIT 

               End DoDot:1

               IF $DATA(DTOUT)!($DATA(DUOUT))

                   QUIT 

 +24       WRITE !

RPTLTTQ   ;EXIT POINT FOR LESS THAN THRESHOLD REPORT

 +1        KILL ^TMP($JOB,"MTLTT"),Y,VA,VAERR,DGFDOL,DGTDOL

           QUIT 

DFORM(DGSDAT,DGTDAT,DGLDOL,DGHDOL) ;

 +1        DO DT^DICRW

           SET Y=DT

           DO DD^%DT

           SET DGPDG=Y

 +2        SET Y=DGSDAT

           DO DD^%DT

           SET DGPSDAT=Y

 +3        SET Y=DGTDAT

           DO DD^%DT

           SET DGPTDAT=Y

 +4        SET DGPLDOL=$SELECT($PIECE(DGLDOL,".",2)="":DGLDOL_".00",1:DGLDOL)

 +5        SET DGPHDOL=$SELECT($PIECE(DGHDOL,".",2)="":DGHDOL_".00",1:DGHDOL)

 +6        QUIT 

HED2      ;

 +1        WRITE @IOF

NOFF2     ;SKIP FORM FEED

 +1        SET Y=$$GETVV()

           SET DGPVAMC=$PIECE(Y,"^")

           SET DGPVISN=$PIECE(Y,"^",3)

           SET DGPVASN=$PIECE(Y,"^",2)

 +2        WRITE !,?12,"VETERANS WITH INCOME - $",DGPLDOL," - $",DGPHDOL," LESS THAN MT THRESHOLD"

 +3        WRITE !,?20,"DETAILED REPORT  ",DGPSDAT," - ",DGPTDAT

 +4        WRITE !,?26,"DATE PRINTED - ",DGPDG

 +5        WRITE !!,"VISN: ",DGPVISN," - VAMC: ",DGPVAMC," (",DGPVASN,")"

 +6        WRITE !!,?47,"INCOME"

 +7        WRITE !,"NAME",?32,"SSN",?47,"$ AMT.",?55,"THRESHOLD",?65,"MT COMPLETED"

 +8        QUIT 

GETVV()   ;GET VISN AND VAMC

 +1        NEW Z,DGVISN,DGVAMCNA,DGVAMCSN

 +2        IF $GET(DUZ(2))=""

               QUIT ""

 +3        SET Z=$$NS^XUAF4(DUZ(2))

 +4        SET DGVAMCNA=$PIECE(Z,"^")

           SET DGVAMCSN=$PIECE(Z,"^",2)

 +5        DO PARENT^XUAF4("DGVISN","`"_DUZ(2),"VISN")

           IF $DATA(DGVISN)

               SET J=$ORDER(DGVISN("P",0))

               SET $PIECE(Z,"^",3)=$PIECE($GET(DGVISN("P",J)),"^")

 +6        QUIT Z