DG53296 ;ALB/JAT DG*5.3*296 POST-INSTALL TO MAILMAN MSG;01 JUNE 2000
;;5.3;Registration;**296**;JUNE 1 2000
;
; This routine is the post-installation for patch DG*5.3*296
;
; This clean up is required as there is a number of redundant entries
; in the Annual Means Test file for patients on a single date. These
; were created due to the MTS's previous ability to order multiple
; income test per patient per day.
;
; A modified version of the DG MEANS TEST DRIVER protocol is called.
;
; Calls:
; DG53296M
; DG53296D
; XPDUTL
;
; ^XTMP("DG-AMTIY",AMTIY) track number of records processed:
; ^XTMP("DG-AMTERR") contains error messages returned from FM DBS calls:
; ^XTMP("DG-AMTERR",file#,record#,field#,n)=error message
;
POST ;
; post-install set up checkpoints and tracking global...
N %,I,X,X1,X2,DGCNT,DGPCT,DGPRIM,DGSRC,IEN,SRC
I $D(XPDNM) D
.; checkpoints
.I $$VERCP^XPDUTL("DGDFN")'>0 D
..S %=$$NEWCP^XPDUTL("DGDFN","",0)
.I $$VERCP^XPDUTL("DGDTE")'>0 D
..S %=$$NEWCP^XPDUTL("DGDTE","",0)
.;
;
; initialize tracking global (see text above for description)...
F I="AMTIY","AMTERR" D
.I $D(^XTMP(I)) Q
.S X1=DT
.S X2=30
.D C^%DTC
.S ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*296 POST-INSTALL "
.S ^XTMP("DG-"_I,0)=^XTMP("DG-"_I,0)_$S(I="AMTIY":"record count",1:"filing errors")
;
EN ; begin processing...
N %
; check status and if root checkpoint has not completed start clean up
I $D(XPDNM) S %=$$VERCP^XPDUTL("DGDFN")
I $G(%)="" S %=0
I %=0 D EN1
Q
;
EN1 ; begin purge...
; write message to installation device and to INSTALL file (#9.7)
D BMES^XPDUTL("POST INSTALLATION PROCESSING")
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 means test entries were 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 purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
;
; process control body
N DGDFN,DGIEN,DGDTE,MTIEN,ERRS
;
I '$D(XPDNM) S DGDFN=""
E S DGDFN=$$PARCP^XPDUTL("DGDFN"),DGDTE=$$PARCP^XPDUTL("DGDTE")
;
;Begin loop search by patient.
F S DGDFN=$O(^DGMT(408.31,"AD",1,DGDFN)) Q:'DGDFN D
.;Now loop through dates
.N ERRS
.D DGDTE
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
; send mailman msg to user/HEC with results
D MAIL^DG53296M
I $D(XPDNM) S %=$$COMCP^XPDUTL("DGDTE")
D MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
;
DGDTE ;Loop through dates by patient.
S:'$D(DGDTE) DGDTE=""
F S DGDTE=$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE)) Q:'DGDTE D
.;Now search for IEN by patient and date
.D DGIEN
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDTE",DGDTE)
Q
;
DGIEN ;Loop through IEN numbers by patient and date.
S (DGPCT,DGCNT)=0,DGIEN=""
F S DGIEN=$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN)) Q:DGIEN="" D
.;Quit if only 1 IEN number for this date
.Q:'$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))&(DGCNT=0)
.;Validate records to delete
.D PREDEL
Q
;
PREDEL ;Validate records to delete
;Is test Primary? What is the source?
S DGPRIM=$G(^DGMT(408.31,DGIEN,"PRIM"),0),DGSRC=$P($G(^DGMT(408.31,DGIEN,0)),U,23)
;Quit if non-primary test doesn't have a source of DCD or Other Facility
D:(DGPRIM&DGSRC)!("^3^4^"[("^"_DGSRC_"^"))
.;Increment counter
.S DGCNT=DGCNT+1
.;Build array for IEN with same patient and date.
.S TMP(DGSRC,DGIEN)=DGPRIM
.;Keep count of primary test
.S DGPCT=DGPCT+TMP(DGSRC,DGIEN)
;Quit if there are more IEN's for this patient and date
Q:$O(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))
;Remove the last record from array by source if no primary for date
I DGPCT=0 F SRC=3,4 D:$D(TMP(SRC))
.S IEN=""
.S IEN=$O(TMP(SRC,IEN),-1) K TMP(SRC,IEN) Q
;Delete if test is Non-Primary
F SRC=3,4 D:$D(TMP(SRC))
.S IEN=""
.F S IEN=$O(TMP(SRC,IEN)) Q:IEN="" D:'TMP(SRC,IEN) DELETE(IEN)
.;If error then update temporary store
.I $G(ERRS) M ^XTMP("DG-AMTERR")=ERRS
;Record delete complete, Kill array and quit
K TMP
Q
;
DELETE(IEN1) ;Delete non-primary test with source of DCD or Other Facility.
; Input:
; IEN1 = Internal Entry Number from 408.31
I '$$EN^DG53296D(IEN1) D
.S ERRS(408.31,IEN1,"ALL")="Unable to delete means test" Q
; increment purged count for income year.
D COUNT(DGDTE)
Q
;
COUNT(DATE) ; update process tracking mechanisms
; Input:
; DATE = inverse date from 408.31
;
N %,IY
S IY=$E(DATE,1,3)-1
S ^XTMP("DG-AMTIY",IY)=+$G(^XTMP("DG-AMTIY",IY))+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53296 4724 printed Apr 09, 2024@21:44:50 Page 2
DG53296 ;ALB/JAT DG*5.3*296 POST-INSTALL TO MAILMAN MSG;01 JUNE 2000
+1 ;;5.3;Registration;**296**;JUNE 1 2000
+2 ;
+3 ; This routine is the post-installation for patch DG*5.3*296
+4 ;
+5 ; This clean up is required as there is a number of redundant entries
+6 ; in the Annual Means Test file for patients on a single date. These
+7 ; were created due to the MTS's previous ability to order multiple
+8 ; income test per patient per day.
+9 ;
+10 ; A modified version of the DG MEANS TEST DRIVER protocol is called.
+11 ;
+12 ; Calls:
+13 ; DG53296M
+14 ; DG53296D
+15 ; XPDUTL
+16 ;
+17 ; ^XTMP("DG-AMTIY",AMTIY) track number of records processed:
+18 ; ^XTMP("DG-AMTERR") contains error messages returned from FM DBS calls:
+19 ; ^XTMP("DG-AMTERR",file#,record#,field#,n)=error message
+20 ;
POST ;
+1 ; post-install set up checkpoints and tracking global...
+2 NEW %,I,X,X1,X2,DGCNT,DGPCT,DGPRIM,DGSRC,IEN,SRC
+3 IF $DATA(XPDNM)
Begin DoDot:1
+4 ; checkpoints
+5 IF $$VERCP^XPDUTL("DGDFN")'>0
Begin DoDot:2
+6 SET %=$$NEWCP^XPDUTL("DGDFN","",0)
End DoDot:2
+7 IF $$VERCP^XPDUTL("DGDTE")'>0
Begin DoDot:2
+8 SET %=$$NEWCP^XPDUTL("DGDTE","",0)
End DoDot:2
+9 ;
End DoDot:1
+10 ;
+11 ; initialize tracking global (see text above for description)...
+12 FOR I="AMTIY","AMTERR"
Begin DoDot:1
+13 IF $DATA(^XTMP(I))
QUIT
+14 SET X1=DT
+15 SET X2=30
+16 DO C^%DTC
+17 SET ^XTMP("DG-"_I,0)=X_U_$$DT^XLFDT_"^DG*5.3*296 POST-INSTALL "
+18 SET ^XTMP("DG-"_I,0)=^XTMP("DG-"_I,0)_$SELECT(I="AMTIY":"record count",1:"filing errors")
End DoDot:1
+19 ;
EN ; begin processing...
+1 NEW %
+2 ; check status and if root checkpoint has not completed start clean up
+3 IF $DATA(XPDNM)
SET %=$$VERCP^XPDUTL("DGDFN")
+4 IF $GET(%)=""
SET %=0
+5 IF %=0
DO EN1
+6 QUIT
+7 ;
EN1 ; begin purge...
+1 ; write message to installation device and to INSTALL file (#9.7)
+2 DO BMES^XPDUTL("POST INSTALLATION PROCESSING")
+3 DO MES^XPDUTL("Once the post-install is completed, a mail message will")
+4 DO MES^XPDUTL("be sent that will report the count of records, by income")
+5 DO MES^XPDUTL("year, from which means test entries were purged.")
+6 DO MES^XPDUTL("Additionally, the report will contain notes")
+7 DO MES^XPDUTL("about any errors encountered during the post-installation.")
+8 DO BMES^XPDUTL("Beginning purge process "_$$FMTE^XLFDT($$NOW^XLFDT))
+9 ;
+10 ; process control body
+11 NEW DGDFN,DGIEN,DGDTE,MTIEN,ERRS
+12 ;
+13 IF '$DATA(XPDNM)
SET DGDFN=""
+14 IF '$TEST
SET DGDFN=$$PARCP^XPDUTL("DGDFN")
SET DGDTE=$$PARCP^XPDUTL("DGDTE")
+15 ;
+16 ;Begin loop search by patient.
+17 FOR
SET DGDFN=$ORDER(^DGMT(408.31,"AD",1,DGDFN))
if 'DGDFN
QUIT
Begin DoDot:1
+18 ;Now loop through dates
+19 NEW ERRS
+20 DO DGDTE
+21 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
End DoDot:1
+22 ; send mailman msg to user/HEC with results
+23 DO MAIL^DG53296M
+24 IF $DATA(XPDNM)
SET %=$$COMCP^XPDUTL("DGDTE")
+25 DO MES^XPDUTL(" >>purge process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
+26 QUIT
+27 ;
DGDTE ;Loop through dates by patient.
+1 if '$DATA(DGDTE)
SET DGDTE=""
+2 FOR
SET DGDTE=$ORDER(^DGMT(408.31,"AD",1,DGDFN,DGDTE))
if 'DGDTE
QUIT
Begin DoDot:1
+3 ;Now search for IEN by patient and date
+4 DO DGIEN
+5 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDTE",DGDTE)
End DoDot:1
+6 QUIT
+7 ;
DGIEN ;Loop through IEN numbers by patient and date.
+1 SET (DGPCT,DGCNT)=0
SET DGIEN=""
+2 FOR
SET DGIEN=$ORDER(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))
if DGIEN=""
QUIT
Begin DoDot:1
+3 ;Quit if only 1 IEN number for this date
+4 if '$ORDER(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))&(DGCNT=0)
QUIT
+5 ;Validate records to delete
+6 DO PREDEL
End DoDot:1
+7 QUIT
+8 ;
PREDEL ;Validate records to delete
+1 ;Is test Primary? What is the source?
+2 SET DGPRIM=$GET(^DGMT(408.31,DGIEN,"PRIM"),0)
SET DGSRC=$PIECE($GET(^DGMT(408.31,DGIEN,0)),U,23)
+3 ;Quit if non-primary test doesn't have a source of DCD or Other Facility
+4 if (DGPRIM&DGSRC)!("^3^4^"[("^"_DGSRC_"^"))
Begin DoDot:1
+5 ;Increment counter
+6 SET DGCNT=DGCNT+1
+7 ;Build array for IEN with same patient and date.
+8 SET TMP(DGSRC,DGIEN)=DGPRIM
+9 ;Keep count of primary test
+10 SET DGPCT=DGPCT+TMP(DGSRC,DGIEN)
End DoDot:1
+11 ;Quit if there are more IEN's for this patient and date
+12 if $ORDER(^DGMT(408.31,"AD",1,DGDFN,DGDTE,DGIEN))
QUIT
+13 ;Remove the last record from array by source if no primary for date
+14 IF DGPCT=0
FOR SRC=3,4
if $DATA(TMP(SRC))
Begin DoDot:1
+15 SET IEN=""
+16 SET IEN=$ORDER(TMP(SRC,IEN),-1)
KILL TMP(SRC,IEN)
QUIT
End DoDot:1
+17 ;Delete if test is Non-Primary
+18 FOR SRC=3,4
if $DATA(TMP(SRC))
Begin DoDot:1
+19 SET IEN=""
+20 FOR
SET IEN=$ORDER(TMP(SRC,IEN))
if IEN=""
QUIT
if 'TMP(SRC,IEN)
DO DELETE(IEN)
+21 ;If error then update temporary store
+22 IF $GET(ERRS)
MERGE ^XTMP("DG-AMTERR")=ERRS
End DoDot:1
+23 ;Record delete complete, Kill array and quit
+24 KILL TMP
+25 QUIT
+26 ;
DELETE(IEN1) ;Delete non-primary test with source of DCD or Other Facility.
+1 ; Input:
+2 ; IEN1 = Internal Entry Number from 408.31
+3 IF '$$EN^DG53296D(IEN1)
Begin DoDot:1
+4 SET ERRS(408.31,IEN1,"ALL")="Unable to delete means test"
QUIT
End DoDot:1
+5 ; increment purged count for income year.
+6 DO COUNT(DGDTE)
+7 QUIT
+8 ;
COUNT(DATE) ; update process tracking mechanisms
+1 ; Input:
+2 ; DATE = inverse date from 408.31
+3 ;
+4 NEW %,IY
+5 SET IY=$EXTRACT(DATE,1,3)-1
+6 SET ^XTMP("DG-AMTIY",IY)=+$GET(^XTMP("DG-AMTIY",IY))+1
+7 QUIT
