DGMTARR ;ALB/GRR/PHH - PRINT ROUTINES FOR MEANS TEST VERIFICATION; JAN 21, 1999
;;5.3;Registration;**217,535**;AUG 13, 1993
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTARR 6734 printed Nov 22, 2024@17:54:33 Page 2
DGMTARR ;ALB/GRR/PHH - PRINT ROUTINES FOR MEANS TEST VERIFICATION; JAN 21, 1999
+1 ;;5.3;Registration;**217,535**;AUG 13, 1993
+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
