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

DG272PT.m

Go to the documentation of this file.
  1. DG272PT ;alb/maw-DG*5.3*272 POST-INSTALL TO PURGE IVM DATA ;2/1/2000
  1. ;;5.3;Registration;**272**;Aug 13, 1993
  1. ;
  1. ; This routine is the post-installation for patch DG*5.3*272.
  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. ; Income years 1992 through 1996
  1. ; Date range = 1/1/93 through 12/31/97
  1. ; Status of test = Category C
  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 ^DG272PT1.
  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("DGMTPCT",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. ; add entry to the IVM CASE CLOSURE REASON file (#301.93)
  1. D CLOSER
  1. ;
  1. ; post-install set up checkpoints and tracking global...
  1. N %,I,X,X1,X2
  1. I $D(XPDNM) D
  1. .; checkpoints for part 1...
  1. .I $$VERCP^XPDUTL("DGMTIDT")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGMTIDT","","-2980101")
  1. .I $$VERCP^XPDUTL("DGMTDFN")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGMTDFN","",0)
  1. .;
  1. .; checkpoints for part 2...
  1. .I $$VERCP^XPDUTL("DGDATE")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGDATE","","2910000")
  1. .I $$VERCP^XPDUTL("DGDFN")'>0 D
  1. ..S %=$$NEWCP^XPDUTL("DGDFN","",0)
  1. ;
  1. ; initialize tracking global (see text above for description)...
  1. F I="DGMTPCT","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*272 POST-INSTALL "_$S(I="DGMTPCT":"record count",1:"filing errors")
  1. I '$D(^XTMP("DGMTPCT",292)) F I=292:1:296 S ^XTMP("DGMTPCT",I)="0^0"
  1. ;
  1. EN ; begin processing...
  1. N %
  1. ; check status of part 1 (purge data)...
  1. I $D(XPDNM) S %=$$VERCP^XPDUTL("DGMTIDT")
  1. I $G(%)="" S %=0
  1. I %=0 D EN1
  1. ;
  1. ; check status of part 2 (close cases)...
  1. I $D(XPDNM) S %=$$VERCP^XPDUTL("DGDATE")
  1. I $G(%)="" S %=0
  1. I %=0 D EN^DG272PT2
  1. Q
  1. ;
  1. EN1 ; begin purge...
  1. D BMES^XPDUTL("POST INSTALLATION PROCESSING")
  1. D BMES^XPDUTL("Statistics for each income year 1992-1996 will be kept")
  1. D MES^XPDUTL("during this purge, and during the case closure process.")
  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 and the number of records")
  1. D MES^XPDUTL("closed. 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 DGMTIDT="-2980101"
  1. I $D(XPDNM) S DGMTIDT=$$PARCP^XPDUTL("DGMTIDT"),DGMTDFN=$$PARCP^XPDUTL("DGMTDFN")
  1. F S DGMTIDT=$O(^DGMT(408.31,"AS",1,6,DGMTIDT)) Q:DGMTIDT=""!($E(DGMTIDT,2,8)<2930101) D
  1. .S:'$D(DGMTDFN) DGMTDFN=0
  1. .F S DGMTDFN=$O(^DGMT(408.31,"AS",1,6,DGMTIDT,DGMTDFN)) Q:'DGMTDFN D
  1. ..S DGMTIE31=0
  1. ..F S DGMTIE31=$O(^DGMT(408.31,"AS",1,6,DGMTIDT,DGMTDFN,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^DG272PT1(+$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^DG272PT1("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^DG272PT1("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^DG272PT1("408.21",DGMTIE21,.DGFILERR)
  1. ....K DGMTIE22
  1. ...K DGMTIE21
  1. ...I '$G(DGFILERR) D COUNT^DG272PT1(DGMTIDT)
  1. ..I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTDFN",DGMTDFN)
  1. ..K DGMTIE31
  1. .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
  1. .K DGMTDFN,DGFILERR
  1. K DGMTIDT
  1. ;
  1. ; clean up and finish...
  1. I $D(XPDNM) S %=$$COMCP^XPDUTL("DGMTIDT")
  1. D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. Q
  1. ;
  1. ;
  1. CLOSER ; Add entries to the IVM CASE CLOSURE REASON (#301.93) file
  1. D BMES^XPDUTL(">>> Adding new entry to IVM CASE CLOSURE REASON (#301.93) file")
  1. ;
  1. ; - if entry already there, display msg and quit
  1. I $O(^IMV(301.93,"B","OLD CASE NO ACTION",0)) D Q
  1. .D MES^XPDUTL(" *** Entry already on file - current values not overwritten ***")
  1. ;
  1. ; - add new entry to (#301.93) file
  1. F IVMX="OLD CASE NO ACTION" D
  1. .Q:$O(^IVM(301.93,"B",IVMX,0))
  1. .S DIC="^IVM(301.93,",DIC(0)="",DLAYGO=301.93,X=IVMX
  1. .K DD,DO D FILE^DICN
  1. ;
  1. D MES^XPDUTL(" Entry has been added")
  1. ;
  1. CLOSERQ K DIC,DLAYGO,IVMX,X,Y
  1. Q