DG284PT ;ALB/SEK-DG*5.3*284 POST-INSTALL TO PURGE IVM DATA ;4/20/2000
;;5.3;Registration;**284**;Aug 13, 1993
;
; This routine is the post-installation for patch DG*5.3*284.
;
; The purge process completed by this routine is required by the
; sharing agreement between VHA, Internal Revenue Service and the
; Social Security Administration. The specific criteria for a
; record to be purged of income data is:
;
; All Income years
; Status of test = ALL STATUSES
; Source of Income Test = IVM
;
; Data will be "purged" by setting the values of specific fields
; equal to null. The list of fields can be found at the end of
; the routine ^DG284PT1.
;
; record number variables:
; DGMTIE21 = record number in 408.21 (INDIVIDUAL ANNUAL INCOME)
; DGMTIE22 = record number in 408.22 (INCOME RELATION)
; DGMTIE31 = record number in 408.31 (ANNUAL MEANS TEST)
;
; ^XTMP("DGMTPAT",income year) tracks the number of records processed:
; $P(^(income year),U,1)=records during purge process
; $P(^(income year),U,2)=records during close process
; ^XTMP("DGMTPERR") contains error messages returned from FM DBS calls:
; ^XTMP("DGMTPERR",file#,record#,field#,n)=error message
;
POST ;
;
; post-install set up checkpoints and tracking global...
N %,I,X,X1,X2
I $D(XPDNM) D
.; checkpoints
.I $$VERCP^XPDUTL("DGMTIDT")'>0 D
..S %=$$NEWCP^XPDUTL("DGMTIDT","","-9999999")
.I $$VERCP^XPDUTL("DGMTDFN")'>0 D
..S %=$$NEWCP^XPDUTL("DGMTDFN","",0)
.;
;
; initialize tracking global (see text above for description)...
F I="DGMTPAT","DGMTPERR" D
.I $D(^XTMP(I)) Q
.S X1=DT
.S X2=30
.D C^%DTC
.S ^XTMP(I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*284 POST-INSTALL "_$S(I="DGMTPAT":"record count",1:"filing errors")
I '$D(^XTMP("DGMTPAT",292)) F I=292:1:296 S ^XTMP("DGMTPAT",I)=0
;
EN ; begin processing...
N %
; check status
I $D(XPDNM) S %=$$VERCP^XPDUTL("DGMTDFN")
I $G(%)="" S %=0
I %=0 D EN1
Q
;
EN1 ; begin purge...
D BMES^XPDUTL("POST INSTALLATION PROCESSING")
D BMES^XPDUTL("Statistics for each income year will be kept")
D MES^XPDUTL("during this purge.")
D MES^XPDUTL("Once the post-install is completed, a mail message will")
D MES^XPDUTL("be sent that will report the count of records, by income")
D MES^XPDUTL("year, from which data was purged.")
D MES^XPDUTL("Additionally, the report will contain notes")
D MES^XPDUTL("about any errors encountered during the post-installation.")
D BMES^XPDUTL("Beginning data purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
;
I '$D(XPDNM) S DGMTDFN=0
I $D(XPDNM) S DGMTIDT=$$PARCP^XPDUTL("DGMTIDT"),DGMTDFN=$$PARCP^XPDUTL("DGMTDFN")
F S DGMTDFN=$O(^DGMT(408.31,"AID",1,DGMTDFN)) Q:'DGMTDFN D
.S:'$D(DGMTIDT) DGMTIDT="-9999999"
.F S DGMTIDT=$O(^DGMT(408.31,"AID",1,DGMTDFN,DGMTIDT)) Q:DGMTIDT="" D
..S DGMTIE31=0
..F S DGMTIE31=$O(^DGMT(408.31,"AID",1,DGMTDFN,DGMTIDT,DGMTIE31)) Q:'DGMTIE31 D
...;
...; quit if already purged...
...I $G(^DGMT(408.31,DGMTIE31,"PURGE"))'="" Q
...;
...; source of income test must be IVM...
...S DGMTDATA=$G(^DGMT(408.31,DGMTIE31,0))
...I $$SRCE^DG284PT1(+$P(DGMTDATA,U,23))'="IVM" K DGMTDATA Q
...K DGMTDATA
...;
...; edit this record in file 408.31...
...S DGFILERR=0
...D EDIT^DG284PT1("408.31",DGMTIE31,.DGFILERR)
...;
...; go to file 408.22...
...S DGMTIE21=0
...F S DGMTIE21=$O(^DGMT(408.22,"AMT",DGMTIE31,DGMTDFN,DGMTIE21)) Q:'DGMTIE21 D
....S DGMTIE22=0
....F S DGMTIE22=$O(^DGMT(408.22,"AMT",DGMTIE31,DGMTDFN,DGMTIE21,DGMTIE22)) Q:'DGMTIE22 D
.....;
.....; edit the record in 408.22...
.....S DGFILERR=0
.....D EDIT^DG284PT1("408.22",DGMTIE22,.DGFILERR)
.....;
.....; use pointer from 408.22 to 408.21 and edit the
.....; record over there...
.....S DGFILERR=0
.....D EDIT^DG284PT1("408.21",DGMTIE21,.DGFILERR)
....K DGMTIE22
...K DGMTIE21
...I '$G(DGFILERR) D COUNT^DG284PT1(DGMTIDT)
..I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
..K DGMTIE31
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTDFN",DGMTDFN)
.K DGMTIDT,DGFILERR
K DGMTDFN
;
; send mailman msg to user/HEC with results
D MAIL^DG284PT2
I $D(XPDNM) S %=$$COMCP^XPDUTL("DGMTDFN")
D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG284PT 4315 printed Dec 13, 2024@02:35:23 Page 2
DG284PT ;ALB/SEK-DG*5.3*284 POST-INSTALL TO PURGE IVM DATA ;4/20/2000
+1 ;;5.3;Registration;**284**;Aug 13, 1993
+2 ;
+3 ; This routine is the post-installation for patch DG*5.3*284.
+4 ;
+5 ; The purge process completed by this routine is required by the
+6 ; sharing agreement between VHA, Internal Revenue Service and the
+7 ; Social Security Administration. The specific criteria for a
+8 ; record to be purged of income data is:
+9 ;
+10 ; All Income years
+11 ; Status of test = ALL STATUSES
+12 ; Source of Income Test = IVM
+13 ;
+14 ; Data will be "purged" by setting the values of specific fields
+15 ; equal to null. The list of fields can be found at the end of
+16 ; the routine ^DG284PT1.
+17 ;
+18 ; record number variables:
+19 ; DGMTIE21 = record number in 408.21 (INDIVIDUAL ANNUAL INCOME)
+20 ; DGMTIE22 = record number in 408.22 (INCOME RELATION)
+21 ; DGMTIE31 = record number in 408.31 (ANNUAL MEANS TEST)
+22 ;
+23 ; ^XTMP("DGMTPAT",income year) tracks the number of records processed:
+24 ; $P(^(income year),U,1)=records during purge process
+25 ; $P(^(income year),U,2)=records during close process
+26 ; ^XTMP("DGMTPERR") contains error messages returned from FM DBS calls:
+27 ; ^XTMP("DGMTPERR",file#,record#,field#,n)=error message
+28 ;
POST ;
+1 ;
+2 ; post-install set up checkpoints and tracking global...
+3 NEW %,I,X,X1,X2
+4 IF $DATA(XPDNM)
Begin DoDot:1
+5 ; checkpoints
+6 IF $$VERCP^XPDUTL("DGMTIDT")'>0
Begin DoDot:2
+7 SET %=$$NEWCP^XPDUTL("DGMTIDT","","-9999999")
End DoDot:2
+8 IF $$VERCP^XPDUTL("DGMTDFN")'>0
Begin DoDot:2
+9 SET %=$$NEWCP^XPDUTL("DGMTDFN","",0)
End DoDot:2
+10 ;
End DoDot:1
+11 ;
+12 ; initialize tracking global (see text above for description)...
+13 FOR I="DGMTPAT","DGMTPERR"
Begin DoDot:1
+14 IF $DATA(^XTMP(I))
QUIT
+15 SET X1=DT
+16 SET X2=30
+17 DO C^%DTC
+18 SET ^XTMP(I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*284 POST-INSTALL "_$S(I="DGMTPAT":"record count",1:"filing errors")
End DoDot:1
+19 IF '$DATA(^XTMP("DGMTPAT",292))
FOR I=292:1:296
SET ^XTMP("DGMTPAT",I)=0
+20 ;
EN ; begin processing...
+1 NEW %
+2 ; check status
+3 IF $DATA(XPDNM)
SET %=$$VERCP^XPDUTL("DGMTDFN")
+4 IF $GET(%)=""
SET %=0
+5 IF %=0
DO EN1
+6 QUIT
+7 ;
EN1 ; begin purge...
+1 DO BMES^XPDUTL("POST INSTALLATION PROCESSING")
+2 DO BMES^XPDUTL("Statistics for each income year will be kept")
+3 DO MES^XPDUTL("during this purge.")
+4 DO MES^XPDUTL("Once the post-install is completed, a mail message will")
+5 DO MES^XPDUTL("be sent that will report the count of records, by income")
+6 DO MES^XPDUTL("year, from which data was purged.")
+7 DO MES^XPDUTL("Additionally, the report will contain notes")
+8 DO MES^XPDUTL("about any errors encountered during the post-installation.")
+9 DO BMES^XPDUTL("Beginning data purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
+10 ;
+11 IF '$DATA(XPDNM)
SET DGMTDFN=0
+12 IF $DATA(XPDNM)
SET DGMTIDT=$$PARCP^XPDUTL("DGMTIDT")
SET DGMTDFN=$$PARCP^XPDUTL("DGMTDFN")
+13 FOR
SET DGMTDFN=$ORDER(^DGMT(408.31,"AID",1,DGMTDFN))
if 'DGMTDFN
QUIT
Begin DoDot:1
+14 if '$DATA(DGMTIDT)
SET DGMTIDT="-9999999"
+15 FOR
SET DGMTIDT=$ORDER(^DGMT(408.31,"AID",1,DGMTDFN,DGMTIDT))
if DGMTIDT=""
QUIT
Begin DoDot:2
+16 SET DGMTIE31=0
+17 FOR
SET DGMTIE31=$ORDER(^DGMT(408.31,"AID",1,DGMTDFN,DGMTIDT,DGMTIE31))
if 'DGMTIE31
QUIT
Begin DoDot:3
+18 ;
+19 ; quit if already purged...
+20 IF $GET(^DGMT(408.31,DGMTIE31,"PURGE"))'=""
QUIT
+21 ;
+22 ; source of income test must be IVM...
+23 SET DGMTDATA=$GET(^DGMT(408.31,DGMTIE31,0))
+24 IF $$SRCE^DG284PT1(+$PIECE(DGMTDATA,U,23))'="IVM"
KILL DGMTDATA
QUIT
+25 KILL DGMTDATA
+26 ;
+27 ; edit this record in file 408.31...
+28 SET DGFILERR=0
+29 DO EDIT^DG284PT1("408.31",DGMTIE31,.DGFILERR)
+30 ;
+31 ; go to file 408.22...
+32 SET DGMTIE21=0
+33 FOR
SET DGMTIE21=$ORDER(^DGMT(408.22,"AMT",DGMTIE31,DGMTDFN,DGMTIE21))
if 'DGMTIE21
QUIT
Begin DoDot:4
+34 SET DGMTIE22=0
+35 FOR
SET DGMTIE22=$ORDER(^DGMT(408.22,"AMT",DGMTIE31,DGMTDFN,DGMTIE21,DGMTIE22))
if 'DGMTIE22
QUIT
Begin DoDot:5
+36 ;
+37 ; edit the record in 408.22...
+38 SET DGFILERR=0
+39 DO EDIT^DG284PT1("408.22",DGMTIE22,.DGFILERR)
+40 ;
+41 ; use pointer from 408.22 to 408.21 and edit the
+42 ; record over there...
+43 SET DGFILERR=0
+44 DO EDIT^DG284PT1("408.21",DGMTIE21,.DGFILERR)
End DoDot:5
+45 KILL DGMTIE22
End DoDot:4
+46 KILL DGMTIE21
+47 IF '$GET(DGFILERR)
DO COUNT^DG284PT1(DGMTIDT)
End DoDot:3
+48 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
+49 KILL DGMTIE31
End DoDot:2
+50 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGMTDFN",DGMTDFN)
+51 KILL DGMTIDT,DGFILERR
End DoDot:1
+52 KILL DGMTDFN
+53 ;
+54 ; send mailman msg to user/HEC with results
+55 DO MAIL^DG284PT2
+56 IF $DATA(XPDNM)
SET %=$$COMCP^XPDUTL("DGMTDFN")
+57 DO MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
+58 QUIT
