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

Last change on this file since 1553 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1DGMTARR ;ALB/GRR/PHH - PRINT ROUTINES FOR MEANS TEST VERIFICATION; JAN 21, 1999
2 ;;5.3;Registration;**217,535**;AUG 13, 1993
3 ;DGLOW - LOW DOLLAR AMOUNT RANGE
4 ;DGHIGH - HIGH DOLLAR AMOUNT RANGE
5 ;DGSDAT - START DATE RANGE
6 ;DGTDAT - END DATE RANGE
7 ;DGINC - PATIENT INCOME AMOUNT
8 ;DGTHR - PATIENT THRESHOLD AMOUNT
9 ;DGNAME - PATIENT NAME
10 ;DGDIFF - AMOUNT OF DIFFERENCE BETWEEN INCOME AND THRESHOLD
11 ;DGVISN - VISN NUMBER
12 ;DGVAMC - VAMC NUMBER
13 ;
14ENSDA ;ENTRY FOR REPORT OF VETERANS WITH SPECIFIC INCOME DOLLAR AMOUNT
15 N DFN,SEX,DGLOW,DGHIGH,DGFDOL,DGTDOL,DGSDAT,DGTDAT
16 W !!,"Veterans with Income of a Specified Dollar Amount"
17 S DGLOW=0,DGHIGH=99999
18 S Y=$$DOLRAN(DGLOW,DGHIGH) Q:Y<0
19 S DGFDOL=$P(Y,"^"),DGTDOL=$P(Y,"^",2)
20 S Y=$$DATRAN() Q:'Y
21 S DGSDAT=$P(Y,"^"),DGTDAT=$P(Y,"^",2)
22 F X="DGFDOL","DGTDOL","DGSDAT","DGTDAT" S ZTSAVE(X)=""
23 D EN^XUTMDEVQ("RPTSDA^DGMTARR","MT Specific Income Report",.ZTSAVE)
24 D HOME^%ZIS
25 Q
26RPTSDA ;ENTRY POINT FROM XUTMDEVQ
27 N DFN,SEX,VADM,DGDAT,DGIEN,DGMT0,DGINC,DGNAME,SSN,DGMTDATE,DGPMDT,DGPVISN,DGPVAMC,Y,VAERR,VA,DGPDG,DGPHDOL,DGPLDOL,DGPSDAT,DGPTDAT,DGPVASN
28 D DFORM(DGSDAT,DGTDAT,DGFDOL,DGTDOL)
29 K ^TMP($J,"MTSPI")
30 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
31 .S DGMT0=$G(^DGMT(408.31,DGIEN,0))
32 .S DGINC=$P(DGMT0,"^",4) Q:DGINC=""
33 .Q:$P(DGMT0,"^",19)'=1
34 .I DGINC'<DGFDOL&(DGINC'>DGTDOL) D
35 ..S DFN=$P(DGMT0,"^",2) D DEM^VADPT Q:$G(VADM(6))]"" S DGNAME=$G(VADM(1)),SSN=$P($G(VADM(2)),"^",2)
36 ..S ^TMP($J,"MTSPI",DGINC,DGNAME,DFN)=SSN_"^"_DGDAT
37 I $E(IOST,1,2)="C-" W @IOF
38 D NOFF
39 I $O(^TMP($J,"MTSPI",-1))="" W !,"NO MATCHING PATIENTS FOUND!",@IOF G RPTSDAQ
40 S DGINC=-1 F S DGINC=$O(^TMP($J,"MTSPI",DGINC)) Q:DGINC="" D Q:$D(DTOUT)!($D(DUOUT))
41 .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))
42 ..S SSN=$P(^TMP($J,"MTSPI",DGINC,DGNAME,DFN),"^"),DGMTDATE=$P(^(DFN),"^",2),Y=DGMTDATE D DD^%DT S DGPMDT=Y
43 ..I $Y+2>IOSL D Q:$D(DTOUT)!($D(DUOUT))
44 ...I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))
45 ...D HED
46 ..W !,DGNAME,?32,SSN,?53-$L(DGINC),DGINC,?60,DGPMDT
47 W !
48RPTSDAQ ;EXIT POINT FOR SPECIFIC INCOME REPORT
49 K ^TMP($J,"MTSPI"),DGSDAT,DGTDAT,Y Q
50DATRAN() ;ASK DATE RANGE
51 N DGFDAT,DGTDAT
52 D DT^DICRW
53 S DIR(0)="D^2990101:"_DT_":EX",DIR("A")="Enter From Date" D ^DIR K DIR
54 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 0
55 S DGFDAT=Y\1
56 S DIR(0)="D^"_DGFDAT_":"_DT_":EX",DIR("A")="Enter To Date" D ^DIR K DIR
57 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 0
58 S DGTDAT=Y
59 Q DGFDAT_"^"_DGTDAT
60DOLRAN(DGLOW,DGHIGH) ;ASK DOLLAR RANGE
61 N DGLDOL,DGHDOL,Y
62 S DIR(0)="N^"_DGLOW_":"_DGHIGH_":2",DIR("A")="Enter Low Dollar Amount" D ^DIR K DIR
63 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) -1
64 S DGLDOL=Y
65 S DIR(0)="N^"_DGLDOL_":"_DGHIGH_":2",DIR("A")="Enter High Dollar Amount" D ^DIR K DIR
66 Q:$D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) -1
67 S DGHDOL=Y
68 Q DGLDOL_"^"_DGHDOL
69HED ;PRINT HEADER
70 W @IOF
71NOFF ;SKIP FORM FEED
72 S Y=$$GETVV(),DGPVAMC=$P(Y,"^"),DGPVISN=$P(Y,"^",3),DGPVASN=$P(Y,"^",2)
73 W !,?25,"VETERANS WITH INCOME - $",DGPLDOL," - $",DGPHDOL
74 W !,?20,"DETAILED REPORT ",DGPSDAT," - ",DGPTDAT
75 W !,?26,"DATE PRINTED - ",DGPDG
76 W !!,"VISN: ",DGPVISN," - VAMC: ",DGPVAMC," (",DGPVASN,")"
77 W !!,"NAME",?32,"SSN",?45,"$ AMOUNT",?60,"MT COMPLETED",!
78 Q
79 ;
80ENLTT ;CREATE AND PRINT VETERANS WITH INCOME LESS THAN THRESHOLD
81 N DGLOW,DGHIGH,DGLDOL,DGHDOL,DGSDAT,DGTDAT
82 W !!,"Veterans with Income Less than MT Threshold"
83 S DGLOW=0,DGHIGH=99999
84 S Y=$$DOLRAN(DGLOW,DGHIGH) Q:Y<0
85 S DGFDOL=$P(Y,"^"),DGTDOL=$P(Y,"^",2)
86 S Y=$$DATRAN() Q:Y<0
87 S DGSDAT=$P(Y,"^"),DGTDAT=$P(Y,"^",2)
88 F X="DGFDOL","DGTDOL","DGSDAT","DGTDAT" S ZTSAVE(X)=""
89 D EN^XUTMDEVQ("RPTLTT^DGMTARR","MT less than threshold report",.ZTSAVE)
90 D HOME^%ZIS
91 Q
92RPTLTT ;BUILD AND PRINT LESS THAN THRESHOLD REPORT. ENTRY POINT FROM XUTMDEVQ
93 N DGDAT,DFN,SEX,DGIEN,DGINC,DGTHR,DGLDOL,DGHDOL,VADM,SSN,DGPVISN,DGPVAMC,DGDIFF,DGMT0,DGNAME,DGPDG,DGPHDOL,DGPLDOL,DGPMDT,DGPSDAT,DGPTDAT,DGPVASN
94 D DFORM(DGSDAT,DGTDAT,DGFDOL,DGTDOL)
95 K ^TMP($J,"MTLTT")
96 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
97 .S DGMT0=$G(^DGMT(408.31,DGIEN,0))
98 .S DGINC=$P(DGMT0,"^",4),DGTHR=+$P(DGMT0,"^",12) Q:DGINC=""
99 .Q:$P(DGMT0,"^",19)'=1
100 .Q:DGINC>DGTHR
101 .S DGDIFF=DGTHR-DGINC
102 .I DGDIFF'<DGFDOL&(DGDIFF'>DGTDOL) D
103 ..S DFN=$P(DGMT0,"^",2) D DEM^VADPT Q:$G(VADM(6))]"" S DGNAME=$G(VADM(1)),SSN=$P($G(VADM(2)),"^",2)
104 ..S ^TMP($J,"MTLTT",DGTHR,DGINC,DGNAME,DFN)=SSN_"^"_DGDAT
105 I $E(IOST,1,2)="C-" W @IOF
106 D NOFF2
107 I $O(^TMP($J,"MTLTT",-1))'>0 W !,"NO MATCHING PATIENTS FOUND!",@IOF G RPTLTTQ
108 S DGTHR=-1 F S DGTHR=$O(^TMP($J,"MTLTT",DGTHR)) Q:DGTHR="" D Q:$D(DTOUT)!($D(DUOUT))
109 .S DGINC=-1 W !
110 .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))
111 ..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)
112 ..I $Y+2>IOSL D Q:$D(DTOUT)!($D(DUOUT))
113 ...I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))
114 ...D HED2
115 ..W !,DGNAME,?32,SSN,?53-$L($J(DGINC,7,2)),$J(DGINC,7,2),?57,DGTHR,?65,DGPMDT
116 W !
117RPTLTTQ ;EXIT POINT FOR LESS THAN THRESHOLD REPORT
118 K ^TMP($J,"MTLTT"),Y,VA,VAERR,DGFDOL,DGTDOL Q
119DFORM(DGSDAT,DGTDAT,DGLDOL,DGHDOL) ;
120 D DT^DICRW S Y=DT D DD^%DT S DGPDG=Y
121 S Y=DGSDAT D DD^%DT S DGPSDAT=Y
122 S Y=DGTDAT D DD^%DT S DGPTDAT=Y
123 S DGPLDOL=$S($P(DGLDOL,".",2)="":DGLDOL_".00",1:DGLDOL)
124 S DGPHDOL=$S($P(DGHDOL,".",2)="":DGHDOL_".00",1:DGHDOL)
125 Q
126HED2 ;
127 W @IOF
128NOFF2 ;SKIP FORM FEED
129 S Y=$$GETVV(),DGPVAMC=$P(Y,"^"),DGPVISN=$P(Y,"^",3),DGPVASN=$P(Y,"^",2)
130 W !,?12,"VETERANS WITH INCOME - $",DGPLDOL," - $",DGPHDOL," LESS THAN MT THRESHOLD"
131 W !,?20,"DETAILED REPORT ",DGPSDAT," - ",DGPTDAT
132 W !,?26,"DATE PRINTED - ",DGPDG
133 W !!,"VISN: ",DGPVISN," - VAMC: ",DGPVAMC," (",DGPVASN,")"
134 W !!,?47,"INCOME"
135 W !,"NAME",?32,"SSN",?47,"$ AMT.",?55,"THRESHOLD",?65,"MT COMPLETED"
136 Q
137GETVV() ;GET VISN AND VAMC
138 N Z,DGVISN,DGVAMCNA,DGVAMCSN
139 Q:$G(DUZ(2))="" ""
140 S Z=$$NS^XUAF4(DUZ(2))
141 S DGVAMCNA=$P(Z,"^"),DGVAMCSN=$P(Z,"^",2)
142 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)),"^")
143 Q Z
Note: See TracBrowser for help on using the repository browser.