Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53376A

DG53376A.m

Go to the documentation of this file.
  1. DG53376A ;ALB/RTK-Edit Cat A MT; 04/11/01
  1. ;;5.3;Registration;**376,1015**;Aug 13, 1993;Build 21
  1. ;
  1. ;
  1. ;Ensure that all Cat A means tests dated within the last
  1. ;year meet the following criteria:
  1. ;
  1. ; AGREED TO PAY DEDUCTIBLE set to NULL
  1. ; DECLINES TO GIVE INCOME INFO set to NULL
  1. ;
  1. ;Edit records that do not conform.
  1. ;
  1. F I="MTRC","EDIT","FERR" D
  1. .I $D(^XTMP("DG-"_I)) Q
  1. .S X1=DT
  1. .S X2=30
  1. .D C^%DTC
  1. .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")
  1. ;
  1. S (^XTMP("DG-MTRC",1),^XTMP("DG-EDIT",1))=0
  1. ;
  1. N CHKDT,CHKREC,MTIEN,DATA
  1. S CHKDT=$$FMADD^XLFDT(DT,-365) ;go back one year
  1. S MTIEN=0 F S MTIEN=$O(^DGMT(408.31,MTIEN)) Q:'+MTIEN D
  1. .I $G(^DGMT(408.31,MTIEN,"PRIM"))=1 D
  1. ..S CHKREC=$G(^DGMT(408.31,MTIEN,0))
  1. ..;if Cat A and less than 365 days old, process
  1. ..I CHKREC'="",$P(CHKREC,"^",3)=4,$P(CHKREC,"^")>CHKDT S ^XTMP("DG-MTRC",1)=^XTMP("DG-MTRC",1)+1 N DATA D
  1. ...;if AGREED TO PAY DEDUCT is not null, change
  1. ...I $P(CHKREC,"^",11)'="" S DATA(.11)=""
  1. ...;if DECLINE TO GIVE INCOME INFO is 1 (Yes), change to null
  1. ...I $P(CHKREC,"^",14)=1 S DATA(.14)=""
  1. ...I $D(DATA) S ^XTMP("DG-EDIT",1)=^XTMP("DG-EDIT",1)+1,DGENDA=MTIEN D
  1. ....I '$$UPD^DGENDBS(408.31,.DGENDA,.DATA) S FILERR(408.31,MTIEN)="Unable to edit means test"
  1. D MAIL^DG53376M
  1. D BMES^XPDUTL(" Cat A means test edit routine has completed successfully.")
  1. Q