- DG284PT ;ALB/SEK-DG*5.3*284 POST-INSTALL TO PURGE IVM DATA ;4/20/2000
- ;;5.3;Registration;**284,1015**;Aug 13, 1993;Build 21
- ;
- ; 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
- 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
- +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