- DG311RPT ;ALB/JJG-Patch DG*5.3*311 Means Test Update Report ; 07 AUG 2000
- ;;5.3;Registration;**311,1015**;Aug 13, 1993;Build 21
- ;
- ; 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
- DG311RPT ;ALB/JJG-Patch DG*5.3*311 Means Test Update Report ; 07 AUG 2000
- +1 ;;5.3;Registration;**311,1015**;Aug 13, 1993;Build 21
- +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
