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 ---[H[J[2J[HDG53376A 1465 printed Dec 13, 2024@02:37: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
