DG311RPT.m

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

HEADER ; Report Header

 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

FOOTER ; Report Footer

 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 

HEADER    ; Report Header

 +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 

FOOTER    ; Report Footer

 +1        USE IO

           WRITE !!!,?(IOM-19/2),"***End Of Report***"

 +2        QUIT