DG53376A.m

DG53376A ;ALB/RTK-Edit Cat A MT; 04/11/01

 ;;5.3;Registration;**376**;Aug 13, 1993

 ;

 ;

 ;Ensure that all Cat A means tests dated within the last 

 ;year meet the following criteria:

 ;

 ;  AGREED TO PAY DEDUCTIBLE set to NULL

 ;  DECLINES TO GIVE INCOME INFO set to NULL

 ;

 ;Edit records that do not conform.

 ;

 F I="MTRC","EDIT","FERR" D

 .I $D(^XTMP("DG-"_I)) Q

 .S X1=DT

 .S X2=30

 .D C^%DTC

 .S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*376 MT CAT A EDIT "_$S(I="MTRC":"cat a means test count",I="EDIT":"edited records",1:"filing errors")

 ;

 S (^XTMP("DG-MTRC",1),^XTMP("DG-EDIT",1))=0

 ;

 N CHKDT,CHKREC,MTIEN,DATA

 S CHKDT=$$FMADD^XLFDT(DT,-365) ;go back one year

 S MTIEN=0 F  S MTIEN=$O(^DGMT(408.31,MTIEN)) Q:'+MTIEN  D

 .I $G(^DGMT(408.31,MTIEN,"PRIM"))=1 D

 ..S CHKREC=$G(^DGMT(408.31,MTIEN,0))

 ..;if Cat A and less than 365 days old, process

 ..I CHKREC'="",$P(CHKREC,"^",3)=4,$P(CHKREC,"^")>CHKDT S ^XTMP("DG-MTRC",1)=^XTMP("DG-MTRC",1)+1 N DATA D

 ...;if AGREED TO PAY DEDUCT is not null, change

 ...I $P(CHKREC,"^",11)'="" S DATA(.11)=""

 ...;if DECLINE TO GIVE INCOME INFO is 1 (Yes), change to null

 ...I $P(CHKREC,"^",14)=1 S DATA(.14)=""

 ...I $D(DATA) S ^XTMP("DG-EDIT",1)=^XTMP("DG-EDIT",1)+1,DGENDA=MTIEN D

 ....I '$$UPD^DGENDBS(408.31,.DGENDA,.DATA) S FILERR(408.31,MTIEN)="Unable to edit means test"

 D MAIL^DG53376M

 D BMES^XPDUTL(" Cat A means test edit routine has completed successfully.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53376A   1465     printed  Apr 09, 2024@21:52:20                                                                                                                                                                                                    Page 2

DG53376A  ;ALB/RTK-Edit Cat A MT; 04/11/01

 +1       ;;5.3;Registration;**376**;Aug 13, 1993

 +2       ;

 +3       ;

 +4       ;Ensure that all Cat A means tests dated within the last 

 +5       ;year meet the following criteria:

 +6       ;

 +7       ;  AGREED TO PAY DEDUCTIBLE set to NULL

 +8       ;  DECLINES TO GIVE INCOME INFO set to NULL

 +9       ;

 +10      ;Edit records that do not conform.

 +11      ;

 +12       FOR I="MTRC","EDIT","FERR"

               Begin DoDot:1

 +13               IF $DATA(^XTMP("DG-"_I))

                       QUIT 

 +14               SET X1=DT

 +15               SET X2=30

 +16               DO C^%DTC

 +17               SET ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*376 MT CAT A EDIT "_$S(I="MTRC":"cat a means test count",I="EDIT":"edited records",1:"filing errors")

               End DoDot:1

 +18      ;

 +19       SET (^XTMP("DG-MTRC",1),^XTMP("DG-EDIT",1))=0

 +20      ;

 +21       NEW CHKDT,CHKREC,MTIEN,DATA

 +22      ;go back one year

           SET CHKDT=$$FMADD^XLFDT(DT,-365)

 +23       SET MTIEN=0

           FOR 

               SET MTIEN=$ORDER(^DGMT(408.31,MTIEN))

               if '+MTIEN

                   QUIT 

               Begin DoDot:1

 +24               IF $GET(^DGMT(408.31,MTIEN,"PRIM"))=1

                       Begin DoDot:2

 +25                       SET CHKREC=$GET(^DGMT(408.31,MTIEN,0))

 +26      ;if Cat A and less than 365 days old, process

 +27                       IF CHKREC'=""

                               IF $PIECE(CHKREC,"^",3)=4

                                   IF $PIECE(CHKREC,"^")>CHKDT

                                       SET ^XTMP("DG-MTRC",1)=^XTMP("DG-MTRC",1)+1

                                       NEW DATA

                                       Begin DoDot:3

 +28      ;if AGREED TO PAY DEDUCT is not null, change

 +29                                       IF $PIECE(CHKREC,"^",11)'=""

                                               SET DATA(.11)=""

 +30      ;if DECLINE TO GIVE INCOME INFO is 1 (Yes), change to null

 +31                                       IF $PIECE(CHKREC,"^",14)=1

                                               SET DATA(.14)=""

 +32                                       IF $DATA(DATA)

                                               SET ^XTMP("DG-EDIT",1)=^XTMP("DG-EDIT",1)+1

                                               SET DGENDA=MTIEN

                                               Begin DoDot:4

 +33                                               IF '$$UPD^DGENDBS(408.31,.DGENDA,.DATA)

                                                       SET FILERR(408.31,MTIEN)="Unable to edit means test"

                                               End DoDot:4

                                       End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34       DO MAIL^DG53376M

 +35       DO BMES^XPDUTL(" Cat A means test edit routine has completed successfully.")

 +36       QUIT