DG311RPT ;ALB/JJG-Patch DG*5.3*311 Means Test Update Report ; 07 AUG 2000
;;5.3;Registration;**311**;Aug 13, 1993
;
; This routine will produce a report that displays those Veterans who
; had their records in the ANNUAL MEANS TEST file (#408.31) corrected
; by routine DG311PIR. The report will display the following fields:
; Veteran Name, Veteran SSN, Income Year, Old Status, New Status
; This report is intended to be run immediately after patch DG*5.3*311
; is installed at the site.
;
MAIN ; Main Driver
;
D SEL ; Select output device
Q
SEL ;
; Select IO Device
K DIRUT
S %ZIS="Q" D ^%ZIS
I POP W !!?5,"Report cancelled!" Q
I $D(IO("Q")) D QUEUE Q
D START,^%ZISC Q
QUEUE ;
S ZTRTN="START^DG311RPT",ZTDESC="Means Test Update Report"
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report cancelled!" H 2
E W !!?5,"Report queued!" H 2
D HOME^%ZIS Q
START ;
; Produce Report
N DGVET,DGSSN,DGYR,DGOST,DGNST
S (DGVET,DGSSN,DGYR,DGOST,DGNST)=""
D HEADER
F S DGVET=$O(^XTMP("DG311PIR",DGVET)) Q:DGVET']"" D
.F S DGSSN=$O(^XTMP("DG311PIR",DGVET,DGSSN)) Q:DGSSN']"" D
..F S DGYR=$O(^XTMP("DG311PIR",DGVET,DGSSN,DGYR)) Q:DGYR']"" D
...F S DGOST=$O(^XTMP("DG311PIR",DGVET,DGSSN,DGYR,DGOST)) Q:DGOST']"" D
....Q:(DGOST'=4)&(DGOST'=6)&(DGOST'=7)&(DGOST'=8) ; Only want Cat 'A', Cat 'C', Exempt or Non-exempt
....S DGOLDSTA=$$EXTERNAL^DILFD(408.31,.03,,DGOST)
....F S DGNST=$O(^XTMP("DG311PIR",DGVET,DGSSN,DGYR,DGOST,DGNST)) Q:DGNST']"" D
.....S DGNEWSTA=$$EXTERNAL^DILFD(408.31,.03,,DGNST)
.....Q:(DGOST=DGNST) ; Only print those instances where the Status changed
.....I IOM=80 W !!,$E(DGVET,1,25),?28,DGSSN,?42,DGYR,?48,$E(DGOLDSTA,1,15),?65,$E(DGNEWSTA,1,15)
.....E W !!,DGVET,?36,DGSSN,?53,DGYR,?62,DGOLDSTA,?87,DGNEWSTA
D FOOTER
Q
N X,Y,NOW
D NOW^%DTC S Y=X X ^DD("DD") S NOW=Y
U IO W @IOF,!!!,?(IOM-26/2),"Updated Means Test Listing"
W !!,"Run Date: ",NOW
I IOM=80 D
. W !!,"Veteran Name",?28,"Veteran SSN",?42,"Year",?48,"Old Status",?65,"New Status"
. W !,"============",?28,"===========",?42,"====",?48,"==========",?65,"=========="
E D
. W !!,"Veteran Name",?36,"Veteran SSN",?49,"Income Year",?62,"Old Means Test Status",?87,"New Means Test Status"
. W !,"============",?36,"===========",?49,"===========",?62,"=====================",?87,"====================="
Q
U IO W !!!,?(IOM-19/2),"***End Of Report***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG311RPT 2478 printed Apr 09, 2024@21:48:49 Page 2
DG311RPT ;ALB/JJG-Patch DG*5.3*311 Means Test Update Report ; 07 AUG 2000
+1 ;;5.3;Registration;**311**;Aug 13, 1993
+2 ;
+3 ; This routine will produce a report that displays those Veterans who
+4 ; had their records in the ANNUAL MEANS TEST file (#408.31) corrected
+5 ; by routine DG311PIR. The report will display the following fields:
+6 ; Veteran Name, Veteran SSN, Income Year, Old Status, New Status
+7 ; This report is intended to be run immediately after patch DG*5.3*311
+8 ; is installed at the site.
+9 ;
MAIN ; Main Driver
+1 ;
+2 ; Select output device
DO SEL
+3 QUIT
SEL ;
+1 ; Select IO Device
+2 KILL DIRUT
+3 SET %ZIS="Q"
DO ^%ZIS
+4 IF POP
WRITE !!?5,"Report cancelled!"
QUIT
+5 IF $DATA(IO("Q"))
DO QUEUE
QUIT
+6 DO START
DO ^%ZISC
QUIT
QUEUE ;
+1 SET ZTRTN="START^DG311RPT"
SET ZTDESC="Means Test Update Report"
+2 DO ^%ZTLOAD
+3 IF $DATA(ZTSK)[0
WRITE !!?5,"Report cancelled!"
HANG 2
+4 IF '$TEST
WRITE !!?5,"Report queued!"
HANG 2
+5 DO HOME^%ZIS
QUIT
START ;
+1 ; Produce Report
+2 NEW DGVET,DGSSN,DGYR,DGOST,DGNST
+3 SET (DGVET,DGSSN,DGYR,DGOST,DGNST)=""
+4 DO HEADER
+5 FOR
SET DGVET=$ORDER(^XTMP("DG311PIR",DGVET))
if DGVET']""
QUIT
Begin DoDot:1
+6 FOR
SET DGSSN=$ORDER(^XTMP("DG311PIR",DGVET,DGSSN))
if DGSSN']""
QUIT
Begin DoDot:2
+7 FOR
SET DGYR=$ORDER(^XTMP("DG311PIR",DGVET,DGSSN,DGYR))
if DGYR']""
QUIT
Begin DoDot:3
+8 FOR
SET DGOST=$ORDER(^XTMP("DG311PIR",DGVET,DGSSN,DGYR,DGOST))
if DGOST']""
QUIT
Begin DoDot:4
+9 ; Only want Cat 'A', Cat 'C', Exempt or Non-exempt
if (DGOST'=4)&(DGOST'=6)&(DGOST'=7)&(DGOST'=8)
QUIT
+10 SET DGOLDSTA=$$EXTERNAL^DILFD(408.31,.03,,DGOST)
+11 FOR
SET DGNST=$ORDER(^XTMP("DG311PIR",DGVET,DGSSN,DGYR,DGOST,DGNST))
if DGNST']""
QUIT
Begin DoDot:5
+12 SET DGNEWSTA=$$EXTERNAL^DILFD(408.31,.03,,DGNST)
+13 ; Only print those instances where the Status changed
if (DGOST=DGNST)
QUIT
+14 IF IOM=80
WRITE !!,$EXTRACT(DGVET,1,25),?28,DGSSN,?42,DGYR,?48,$EXTRACT(DGOLDSTA,1,15),?65,$EXTRACT(DGNEWSTA,1,15)
+15 IF '$TEST
WRITE !!,DGVET,?36,DGSSN,?53,DGYR,?62,DGOLDSTA,?87,DGNEWSTA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 DO FOOTER
+17 QUIT
+1 NEW X,Y,NOW
+2 DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
SET NOW=Y
+3 USE IO
WRITE @IOF,!!!,?(IOM-26/2),"Updated Means Test Listing"
+4 WRITE !!,"Run Date: ",NOW
+5 IF IOM=80
Begin DoDot:1
+6 WRITE !!,"Veteran Name",?28,"Veteran SSN",?42,"Year",?48,"Old Status",?65,"New Status"
+7 WRITE !,"============",?28,"===========",?42,"====",?48,"==========",?65,"=========="
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !!,"Veteran Name",?36,"Veteran SSN",?49,"Income Year",?62,"Old Means Test Status",?87,"New Means Test Status"
+10 WRITE !,"============",?36,"===========",?49,"===========",?62,"=====================",?87,"====================="
End DoDot:1
+11 QUIT
+1 USE IO
WRITE !!!,?(IOM-19/2),"***End Of Report***"
+2 QUIT
