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

DG284PT.m

Go to the documentation of this file.
  1. DG284PT ;ALB/SEK-DG*5.3*284 POST-INSTALL TO PURGE IVM DATA ;4/20/2000
  1. ;;5.3;Registration;**284,1015**;Aug 13, 1993;Build 21
  1. ;
  1. ; This routine is the post-installation for patch DG*5.3*284.
  1. ;
  1. ; The purge process completed by this routine is required by the
  1. ; sharing agreement between VHA, Internal Revenue Service and the
  1. ; Social Security Administration. The specific criteria for a
  1. ; record to be purged of income data is:
  1. ;
  1. ; All Income years
  1. ; Status of test = ALL STATUSES
  1. ; Source of Income Test = IVM
  1. ;
  1. ; Data will be "purged" by setting the values of specific fields
  1. ; equal to null. The list of fields can be found at the end of
  1. ; the routine ^DG284PT1.
  1. ;
  1. ; record number variables:
  1. ; DGMTIE21 = record number in 408.21 (INDIVIDUAL ANNUAL INCOME)
  1. ; DGMTIE22 = record number in 408.22 (INCOME RELATION)
  1. ; DGMTIE31 = record number in 408.31 (ANNUAL MEANS TEST)
  1. ;
  1. ; ^XTMP("DGMTPAT",income year) tracks the number of records processed:
  1. ; $P(^(income year),U,1)=records during purge process
  1. ; $P(^(income year),U,2)=records during close process
  1. ; ^XTMP("DGMTPERR") contains error messages returned from FM DBS calls:
  1. ; ^XTMP("DGMTPERR",file#,record#,field#,n)=error message
  1. ;
  1. POST ;
  1. ;
  1. ; post-install set up checkpoints and tracking global...
  1. N %,I,X,X1,X2
  1. I $D(XPDNM) D
  1. .; checkpoints
  1. .I $$VERCP^XPDUTL("DGMTIDT")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGMTIDT","","-9999999")
  1. .I $$VERCP^XPDUTL("DGMTDFN")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGMTDFN","",0)
  1. .;
  1. ;
  1. ; initialize tracking global (see text above for description)...
  1. F I="DGMTPAT","DGMTPERR" D
  1. .I $D(^XTMP(I)) Q
  1. .S X1=DT
  1. .S X2=30
  1. .D C^%DTC
  1. .S ^XTMP(I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*284 POST-INSTALL "_$S(I="DGMTPAT":"record count",1:"filing errors")
  1. I '$D(^XTMP("DGMTPAT",292)) F I=292:1:296 S ^XTMP("DGMTPAT",I)=0
  1. ;
  1. EN ; begin processing...
  1. N %
  1. ; check status
  1. I $D(XPDNM) S %=$$VERCP^XPDUTL("DGMTDFN")
  1. I $G(%)="" S %=0
  1. I %=0 D EN1
  1. Q
  1. ;
  1. EN1 ; begin purge...
  1. D BMES^XPDUTL("POST INSTALLATION PROCESSING")
  1. D BMES^XPDUTL("Statistics for each income year will be kept")
  1. D MES^XPDUTL("during this purge.")
  1. D MES^XPDUTL("Once the post-install is completed, a mail message will")
  1. D MES^XPDUTL("be sent that will report the count of records, by income")
  1. D MES^XPDUTL("year, from which data was purged.")
  1. D MES^XPDUTL("Additionally, the report will contain notes")
  1. D MES^XPDUTL("about any errors encountered during the post-installation.")
  1. D BMES^XPDUTL("Beginning data purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. ;
  1. I '$D(XPDNM) S DGMTDFN=0
  1. I $D(XPDNM) S DGMTIDT=$$PARCP^XPDUTL("DGMTIDT"),DGMTDFN=$$PARCP^XPDUTL("DGMTDFN")
  1. F S DGMTDFN=$O(^DGMT(408.31,"AID",1,DGMTDFN)) Q:'DGMTDFN D
  1. .S:'$D(DGMTIDT) DGMTIDT="-9999999"
  1. .F S DGMTIDT=$O(^DGMT(408.31,"AID",1,DGMTDFN,DGMTIDT)) Q:DGMTIDT="" D
  1. ..S DGMTIE31=0
  1. ..F S DGMTIE31=$O(^DGMT(408.31,"AID",1,DGMTDFN,DGMTIDT,DGMTIE31)) Q:'DGMTIE31 D
  1. ...;
  1. ...; quit if already purged...
  1. ...I $G(^DGMT(408.31,DGMTIE31,"PURGE"))'="" Q
  1. ...;
  1. ...; source of income test must be IVM...
  1. ...S DGMTDATA=$G(^DGMT(408.31,DGMTIE31,0))
  1. ...I $$SRCE^DG284PT1(+$P(DGMTDATA,U,23))'="IVM" K DGMTDATA Q
  1. ...K DGMTDATA
  1. ...;
  1. ...; edit this record in file 408.31...
  1. ...S DGFILERR=0
  1. ...D EDIT^DG284PT1("408.31",DGMTIE31,.DGFILERR)
  1. ...;
  1. ...; go to file 408.22...
  1. ...S DGMTIE21=0
  1. ...F S DGMTIE21=$O(^DGMT(408.22,"AMT",DGMTIE31,DGMTDFN,DGMTIE21)) Q:'DGMTIE21 D
  1. ....S DGMTIE22=0
  1. ....F S DGMTIE22=$O(^DGMT(408.22,"AMT",DGMTIE31,DGMTDFN,DGMTIE21,DGMTIE22)) Q:'DGMTIE22 D
  1. .....;
  1. .....; edit the record in 408.22...
  1. .....S DGFILERR=0
  1. .....D EDIT^DG284PT1("408.22",DGMTIE22,.DGFILERR)
  1. .....;
  1. .....; use pointer from 408.22 to 408.21 and edit the
  1. .....; record over there...
  1. .....S DGFILERR=0
  1. .....D EDIT^DG284PT1("408.21",DGMTIE21,.DGFILERR)
  1. ....K DGMTIE22
  1. ...K DGMTIE21
  1. ...I '$G(DGFILERR) D COUNT^DG284PT1(DGMTIDT)
  1. ..I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
  1. ..K DGMTIE31
  1. .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTDFN",DGMTDFN)
  1. .K DGMTIDT,DGFILERR
  1. K DGMTDFN
  1. ;
  1. ; send mailman msg to user/HEC with results
  1. D MAIL^DG284PT2
  1. I $D(XPDNM) S %=$$COMCP^XPDUTL("DGMTDFN")
  1. D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. Q