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

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1DG311RPT ;ALB/JJG-Patch DG*5.3*311 Means Test Update Report ; 07 AUG 2000
2 ;;5.3;Registration;**311**;Aug 13, 1993
3 ;
4 ; This routine will produce a report that displays those Veterans who
5 ; had their records in the ANNUAL MEANS TEST file (#408.31) corrected
6 ; by routine DG311PIR. The report will display the following fields:
7 ; Veteran Name, Veteran SSN, Income Year, Old Status, New Status
8 ; This report is intended to be run immediately after patch DG*5.3*311
9 ; is installed at the site.
10 ;
11MAIN ; Main Driver
12 ;
13 D SEL ; Select output device
14 Q
15SEL ;
16 ; Select IO Device
17 K DIRUT
18 S %ZIS="Q" D ^%ZIS
19 I POP W !!?5,"Report cancelled!" Q
20 I $D(IO("Q")) D QUEUE Q
21 D START,^%ZISC Q
22QUEUE ;
23 S ZTRTN="START^DG311RPT",ZTDESC="Means Test Update Report"
24 D ^%ZTLOAD
25 I $D(ZTSK)[0 W !!?5,"Report cancelled!" H 2
26 E W !!?5,"Report queued!" H 2
27 D HOME^%ZIS Q
28START ;
29 ; Produce Report
30 N DGVET,DGSSN,DGYR,DGOST,DGNST
31 S (DGVET,DGSSN,DGYR,DGOST,DGNST)=""
32 D HEADER
33 F S DGVET=$O(^XTMP("DG311PIR",DGVET)) Q:DGVET']"" D
34 .F S DGSSN=$O(^XTMP("DG311PIR",DGVET,DGSSN)) Q:DGSSN']"" D
35 ..F S DGYR=$O(^XTMP("DG311PIR",DGVET,DGSSN,DGYR)) Q:DGYR']"" D
36 ...F S DGOST=$O(^XTMP("DG311PIR",DGVET,DGSSN,DGYR,DGOST)) Q:DGOST']"" D
37 ....Q:(DGOST'=4)&(DGOST'=6)&(DGOST'=7)&(DGOST'=8) ; Only want Cat 'A', Cat 'C', Exempt or Non-exempt
38 ....S DGOLDSTA=$$EXTERNAL^DILFD(408.31,.03,,DGOST)
39 ....F S DGNST=$O(^XTMP("DG311PIR",DGVET,DGSSN,DGYR,DGOST,DGNST)) Q:DGNST']"" D
40 .....S DGNEWSTA=$$EXTERNAL^DILFD(408.31,.03,,DGNST)
41 .....Q:(DGOST=DGNST) ; Only print those instances where the Status changed
42 .....I IOM=80 W !!,$E(DGVET,1,25),?28,DGSSN,?42,DGYR,?48,$E(DGOLDSTA,1,15),?65,$E(DGNEWSTA,1,15)
43 .....E W !!,DGVET,?36,DGSSN,?53,DGYR,?62,DGOLDSTA,?87,DGNEWSTA
44 D FOOTER
45 Q
46HEADER ; Report Header
47 N X,Y,NOW
48 D NOW^%DTC S Y=X X ^DD("DD") S NOW=Y
49 U IO W @IOF,!!!,?(IOM-26/2),"Updated Means Test Listing"
50 W !!,"Run Date: ",NOW
51 I IOM=80 D
52 . W !!,"Veteran Name",?28,"Veteran SSN",?42,"Year",?48,"Old Status",?65,"New Status"
53 . W !,"============",?28,"===========",?42,"====",?48,"==========",?65,"=========="
54 E D
55 . W !!,"Veteran Name",?36,"Veteran SSN",?49,"Income Year",?62,"Old Means Test Status",?87,"New Means Test Status"
56 . W !,"============",?36,"===========",?49,"===========",?62,"=====================",?87,"====================="
57 Q
58FOOTER ; Report Footer
59 U IO W !!!,?(IOM-19/2),"***End Of Report***"
60 Q
Note: See TracBrowser for help on using the repository browser.