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

DG53318P.m

Go to the documentation of this file.
  1. DG53318P ;RTK - Means Test Utilities ;09/22/00
  1. ;;5.3;Registration;**318,1015**;Aug 13, 1993;Build 21
  1. ;This routine will edit the SOURCE OF INCOME TEST (.23) field
  1. ;of the ANNUAL MEANS TEST (#408.31) file to synchronize it
  1. ;with new logic that has been implemented at HEC. The source
  1. ;will be set as follows:
  1. ;
  1. ;If the means test:
  1. ; Originated at this site, the source will be set to VAMC
  1. ; Originated at another site, the source will be set to
  1. ; OTHER FACILITY.
  1. ;
  1. ;If the site is 742(HEC) or the source is NULL or 2(IVM), no
  1. ; action will be taken.
  1. ;
  1. EN N DATA,SDATE,MTIEN,ULINE,STATION,NSITE,OSITE,TSOURCE,I,X,X1,X2,%
  1. S (ERRMSG,FILERR)=""
  1. I $D(XPDNM) D
  1. .I $$VERCP^XPDUTL("SDATE")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("SDATE","","2970101")
  1. .I $$VERCP^XPDUTL("MTIEN")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("MTIEN","","0")
  1. ;
  1. F I="RECRD","FIXED","ERORS" 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*318 POST-INSTALL "_$S(I="RECRD":"record count",I="FIXED":"records corrected",1:"filing errors")
  1. ;
  1. I '$D(XPDNM) S (^XTMP("DG-RECRD",1),^XTMP("DG-FIXED",1))=0
  1. I $D(XPDNM)&'$D(^XTMP("DG-RECRD",1)) S ^XTMP("DG-RECRD",1)=0
  1. I $D(XPDNM)&'$D(^XTMP("DG-FIXED",1)) S ^XTMP("DG-FIXED",1)=0
  1. I $D(XPDNM) S %=$$VERCP^XPDUTL("SDATE")
  1. I $G(%)="" S %=0
  1. I %=0 D EN1
  1. Q
  1. EN1 S SDATE=2970101,MTIEN=""
  1. S STATION=$P($$SITE^VASITE,U,3)
  1. F S SDATE=$O(^DGMT(408.31,"B",SDATE)) Q:SDATE="" D
  1. .F S MTIEN=$O(^DGMT(408.31,"B",SDATE,MTIEN)) Q:MTIEN="" D
  1. ..I '$D(^DGMT(408.31,MTIEN,0)) S FILERR(408.31,MTIEN,"ALL")="Means test missing for record "_MTIEN_"." M ^XTMP("DG-ERORS")=FILERR K FILERR Q
  1. ..S ULINE=$G(^DGMT(408.31,MTIEN,2))
  1. ..S ^XTMP("DG-RECRD",1)=$G(^XTMP("DG-RECRD",1))+1
  1. ..S OSITE=$P(ULINE,U,5),TSOURCE=$P($G(^DGMT(408.31,MTIEN,0)),U,23)
  1. ..I (OSITE="")!(OSITE[742)!(TSOURCE=2) Q
  1. ..I (OSITE[STATION)&(TSOURCE'=1) S DATA(.23)=1 D
  1. ...I $$UPD^DGENDBS(408.31,MTIEN,.DATA) S ^XTMP("DG-FIXED",1)=$G(^XTMP("DG-FIXED",1))+1
  1. ...E S FILERR(408.31,MTIEN,"ALL")="Unable to edit means test "_MTIEN_"." Q
  1. ..I (OSITE'[742)&(OSITE'[STATION)&(TSOURCE'=4) S DATA(.23)=4 D
  1. ...I $$UPD^DGENDBS(408.31,MTIEN,.DATA) S ^XTMP("DG-FIXED",1)=$G(^XTMP("DG-FIXED",1))+1
  1. ...E S FILERR(408.31,MTIEN,"ALL")="Unable to edit means test "_MTIEN_"." Q
  1. ..I $G(FILERR) M ^XTMP("DG-ERORS")=FILERR K FILERR
  1. ..I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",MTIEN)
  1. .I $D(XPDNM) S %=$$UPCP^XPDUTL("SDATE",SDATE)
  1. D MAIL^DG53318M
  1. I $D(XPDNM) S %=$$COMCP^XPDUTL("SDATE")
  1. D BMES^XPDUTL(" SOURCE OF INCOME TEST edit process is complete.")
  1. Q