source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTARR.m@ 1739

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