- DG272PT ;alb/maw-DG*5.3*272 POST-INSTALL TO PURGE IVM DATA ;2/1/2000
- ;;5.3;Registration;**272**;Aug 13, 1993
- ;
- ; This routine is the post-installation for patch DG*5.3*272.
- ;
- ; 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:
- ;
- ; Income years 1992 through 1996
- ; Date range = 1/1/93 through 12/31/97
- ; Status of test = Category C
- ; 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 ^DG272PT1.
- ;
- ; 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("DGMTPCT",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 ;
- ; add entry to the IVM CASE CLOSURE REASON file (#301.93)
- D CLOSER
- ;
- ; post-install set up checkpoints and tracking global...
- N %,I,X,X1,X2
- I $D(XPDNM) D
- .; checkpoints for part 1...
- .I $$VERCP^XPDUTL("DGMTIDT")'>0 D
- ..S %=$$NEWCP^XPDUTL("DGMTIDT","","-2980101")
- .I $$VERCP^XPDUTL("DGMTDFN")'>0 D
- ..S %=$$NEWCP^XPDUTL("DGMTDFN","",0)
- .;
- .; checkpoints for part 2...
- .I $$VERCP^XPDUTL("DGDATE")'>0 D
- ..S %=$$NEWCP^XPDUTL("DGDATE","","2910000")
- .I $$VERCP^XPDUTL("DGDFN")'>0 D
- ..S %=$$NEWCP^XPDUTL("DGDFN","",0)
- ;
- ; initialize tracking global (see text above for description)...
- F I="DGMTPCT","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*272 POST-INSTALL "_$S(I="DGMTPCT":"record count",1:"filing errors")
- I '$D(^XTMP("DGMTPCT",292)) F I=292:1:296 S ^XTMP("DGMTPCT",I)="0^0"
- ;
- EN ; begin processing...
- N %
- ; check status of part 1 (purge data)...
- I $D(XPDNM) S %=$$VERCP^XPDUTL("DGMTIDT")
- I $G(%)="" S %=0
- I %=0 D EN1
- ;
- ; check status of part 2 (close cases)...
- I $D(XPDNM) S %=$$VERCP^XPDUTL("DGDATE")
- I $G(%)="" S %=0
- I %=0 D EN^DG272PT2
- Q
- ;
- EN1 ; begin purge...
- D BMES^XPDUTL("POST INSTALLATION PROCESSING")
- D BMES^XPDUTL("Statistics for each income year 1992-1996 will be kept")
- D MES^XPDUTL("during this purge, and during the case closure process.")
- 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 and the number of records")
- D MES^XPDUTL("closed. 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 DGMTIDT="-2980101"
- I $D(XPDNM) S DGMTIDT=$$PARCP^XPDUTL("DGMTIDT"),DGMTDFN=$$PARCP^XPDUTL("DGMTDFN")
- F S DGMTIDT=$O(^DGMT(408.31,"AS",1,6,DGMTIDT)) Q:DGMTIDT=""!($E(DGMTIDT,2,8)<2930101) D
- .S:'$D(DGMTDFN) DGMTDFN=0
- .F S DGMTDFN=$O(^DGMT(408.31,"AS",1,6,DGMTIDT,DGMTDFN)) Q:'DGMTDFN D
- ..S DGMTIE31=0
- ..F S DGMTIE31=$O(^DGMT(408.31,"AS",1,6,DGMTIDT,DGMTDFN,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^DG272PT1(+$P(DGMTDATA,U,23))'="IVM" K DGMTDATA Q
- ...K DGMTDATA
- ...;
- ...; edit this record in file 408.31...
- ...S DGFILERR=0
- ...D EDIT^DG272PT1("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^DG272PT1("408.22",DGMTIE22,.DGFILERR)
- .....;
- .....; use pointer from 408.22 to 408.21 and edit the
- .....; record over there...
- .....S DGFILERR=0
- .....D EDIT^DG272PT1("408.21",DGMTIE21,.DGFILERR)
- ....K DGMTIE22
- ...K DGMTIE21
- ...I '$G(DGFILERR) D COUNT^DG272PT1(DGMTIDT)
- ..I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTDFN",DGMTDFN)
- ..K DGMTIE31
- .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
- .K DGMTDFN,DGFILERR
- K DGMTIDT
- ;
- ; clean up and finish...
- I $D(XPDNM) S %=$$COMCP^XPDUTL("DGMTIDT")
- D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
- Q
- ;
- ;
- CLOSER ; Add entries to the IVM CASE CLOSURE REASON (#301.93) file
- D BMES^XPDUTL(">>> Adding new entry to IVM CASE CLOSURE REASON (#301.93) file")
- ;
- ; - if entry already there, display msg and quit
- I $O(^IMV(301.93,"B","OLD CASE NO ACTION",0)) D Q
- .D MES^XPDUTL(" *** Entry already on file - current values not overwritten ***")
- ;
- ; - add new entry to (#301.93) file
- F IVMX="OLD CASE NO ACTION" D
- .Q:$O(^IVM(301.93,"B",IVMX,0))
- .S DIC="^IVM(301.93,",DIC(0)="",DLAYGO=301.93,X=IVMX
- .K DD,DO D FILE^DICN
- ;
- D MES^XPDUTL(" Entry has been added")
- ;
- CLOSERQ K DIC,DLAYGO,IVMX,X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG272PT 5498 printed Feb 19, 2025@00:01:24 Page 2
- DG272PT ;alb/maw-DG*5.3*272 POST-INSTALL TO PURGE IVM DATA ;2/1/2000
- +1 ;;5.3;Registration;**272**;Aug 13, 1993
- +2 ;
- +3 ; This routine is the post-installation for patch DG*5.3*272.
- +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 ; Income years 1992 through 1996
- +11 ; Date range = 1/1/93 through 12/31/97
- +12 ; Status of test = Category C
- +13 ; Source of Income Test = IVM
- +14 ;
- +15 ; Data will be "purged" by setting the values of specific fields
- +16 ; equal to null. The list of fields can be found at the end of
- +17 ; the routine ^DG272PT1.
- +18 ;
- +19 ; record number variables:
- +20 ; DGMTIE21 = record number in 408.21 (INDIVIDUAL ANNUAL INCOME)
- +21 ; DGMTIE22 = record number in 408.22 (INCOME RELATION)
- +22 ; DGMTIE31 = record number in 408.31 (ANNUAL MEANS TEST)
- +23 ;
- +24 ; ^XTMP("DGMTPCT",income year) tracks the number of records processed:
- +25 ; $P(^(income year),U,1)=records during purge process
- +26 ; $P(^(income year),U,2)=records during close process
- +27 ; ^XTMP("DGMTPERR") contains error messages returned from FM DBS calls:
- +28 ; ^XTMP("DGMTPERR",file#,record#,field#,n)=error message
- +29 ;
- POST ;
- +1 ; add entry to the IVM CASE CLOSURE REASON file (#301.93)
- +2 DO CLOSER
- +3 ;
- +4 ; post-install set up checkpoints and tracking global...
- +5 NEW %,I,X,X1,X2
- +6 IF $DATA(XPDNM)
- Begin DoDot:1
- +7 ; checkpoints for part 1...
- +8 IF $$VERCP^XPDUTL("DGMTIDT")'>0
- Begin DoDot:2
- +9 SET %=$$NEWCP^XPDUTL("DGMTIDT","","-2980101")
- End DoDot:2
- +10 IF $$VERCP^XPDUTL("DGMTDFN")'>0
- Begin DoDot:2
- +11 SET %=$$NEWCP^XPDUTL("DGMTDFN","",0)
- End DoDot:2
- +12 ;
- +13 ; checkpoints for part 2...
- +14 IF $$VERCP^XPDUTL("DGDATE")'>0
- Begin DoDot:2
- +15 SET %=$$NEWCP^XPDUTL("DGDATE","","2910000")
- End DoDot:2
- +16 IF $$VERCP^XPDUTL("DGDFN")'>0
- Begin DoDot:2
- +17 SET %=$$NEWCP^XPDUTL("DGDFN","",0)
- End DoDot:2
- End DoDot:1
- +18 ;
- +19 ; initialize tracking global (see text above for description)...
- +20 FOR I="DGMTPCT","DGMTPERR"
- Begin DoDot:1
- +21 IF $DATA(^XTMP(I))
- QUIT
- +22 SET X1=DT
- +23 SET X2=30
- +24 DO C^%DTC
- +25 SET ^XTMP(I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*272 POST-INSTALL "_$S(I="DGMTPCT":"record count",1:"filing errors")
- End DoDot:1
- +26 IF '$DATA(^XTMP("DGMTPCT",292))
- FOR I=292:1:296
- SET ^XTMP("DGMTPCT",I)="0^0"
- +27 ;
- EN ; begin processing...
- +1 NEW %
- +2 ; check status of part 1 (purge data)...
- +3 IF $DATA(XPDNM)
- SET %=$$VERCP^XPDUTL("DGMTIDT")
- +4 IF $GET(%)=""
- SET %=0
- +5 IF %=0
- DO EN1
- +6 ;
- +7 ; check status of part 2 (close cases)...
- +8 IF $DATA(XPDNM)
- SET %=$$VERCP^XPDUTL("DGDATE")
- +9 IF $GET(%)=""
- SET %=0
- +10 IF %=0
- DO EN^DG272PT2
- +11 QUIT
- +12 ;
- EN1 ; begin purge...
- +1 DO BMES^XPDUTL("POST INSTALLATION PROCESSING")
- +2 DO BMES^XPDUTL("Statistics for each income year 1992-1996 will be kept")
- +3 DO MES^XPDUTL("during this purge, and during the case closure process.")
- +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 and the number of records")
- +7 DO MES^XPDUTL("closed. 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 DGMTIDT="-2980101"
- +12 IF $DATA(XPDNM)
- SET DGMTIDT=$$PARCP^XPDUTL("DGMTIDT")
- SET DGMTDFN=$$PARCP^XPDUTL("DGMTDFN")
- +13 FOR
- SET DGMTIDT=$ORDER(^DGMT(408.31,"AS",1,6,DGMTIDT))
- if DGMTIDT=""!($EXTRACT(DGMTIDT,2,8)<2930101)
- QUIT
- Begin DoDot:1
- +14 if '$DATA(DGMTDFN)
- SET DGMTDFN=0
- +15 FOR
- SET DGMTDFN=$ORDER(^DGMT(408.31,"AS",1,6,DGMTIDT,DGMTDFN))
- if 'DGMTDFN
- QUIT
- Begin DoDot:2
- +16 SET DGMTIE31=0
- +17 FOR
- SET DGMTIE31=$ORDER(^DGMT(408.31,"AS",1,6,DGMTIDT,DGMTDFN,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^DG272PT1(+$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^DG272PT1("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^DG272PT1("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^DG272PT1("408.21",DGMTIE21,.DGFILERR)
- End DoDot:5
- +45 KILL DGMTIE22
- End DoDot:4
- +46 KILL DGMTIE21
- +47 IF '$GET(DGFILERR)
- DO COUNT^DG272PT1(DGMTIDT)
- End DoDot:3
- +48 IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("DGMTDFN",DGMTDFN)
- +49 KILL DGMTIE31
- End DoDot:2
- +50 IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("DGMTIDT",DGMTIDT)
- +51 KILL DGMTDFN,DGFILERR
- End DoDot:1
- +52 KILL DGMTIDT
- +53 ;
- +54 ; clean up and finish...
- +55 IF $DATA(XPDNM)
- SET %=$$COMCP^XPDUTL("DGMTIDT")
- +56 DO MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
- +57 QUIT
- +58 ;
- +59 ;
- CLOSER ; Add entries to the IVM CASE CLOSURE REASON (#301.93) file
- +1 DO BMES^XPDUTL(">>> Adding new entry to IVM CASE CLOSURE REASON (#301.93) file")
- +2 ;
- +3 ; - if entry already there, display msg and quit
- +4 IF $ORDER(^IMV(301.93,"B","OLD CASE NO ACTION",0))
- Begin DoDot:1
- +5 DO MES^XPDUTL(" *** Entry already on file - current values not overwritten ***")
- End DoDot:1
- QUIT
- +6 ;
- +7 ; - add new entry to (#301.93) file
- +8 FOR IVMX="OLD CASE NO ACTION"
- Begin DoDot:1
- +9 if $ORDER(^IVM(301.93,"B",IVMX,0))
- QUIT
- +10 SET DIC="^IVM(301.93,"
- SET DIC(0)=""
- SET DLAYGO=301.93
- SET X=IVMX
- +11 KILL DD,DO
- DO FILE^DICN
- End DoDot:1
- +12 ;
- +13 DO MES^XPDUTL(" Entry has been added")
- +14 ;
- CLOSERQ KILL DIC,DLAYGO,IVMX,X,Y
- +1 QUIT