DG53289 ;ALB/RMM - Means Test Workload Cleanup Utility ; 23 Aug 2000 7:00 AM
;;5.3;Registration;**289**;Aug 23, 2000
;
; This is a cleanup program for the MT Workload Cleanup
; corected with Patch #DG*5.3*267.
;
; The clean up is required as there is a number of entries in the
; Annual Means Test file (408.31) that have no records set as primary.
;
;
; ^XTMP("DG-MT-IY",MTIY) track number of records processed:
; ^XTMP("DG-MT-ERR") contains error messages returned from FM DBS calls:
; ^XTMP("DG-MT-ERR",file#,record#,field#,n)=error message
;
PRE ;
; Pre-install set up checkpoint and tracking global...
N %,I,X,X1,X2
I $D(XPDNM) D
.; Checkpoint
.I $$VERCP^XPDUTL("DGDFN")'>0 D
..S %=$$NEWCP^XPDUTL("DGDFN","",0)
;
; Initialize tracking global (See text above for description)
F I="MT-IY","MT-ERR" D
.I $D(^XTMP("DG-"_I)) Q
.S X1=DT
.S X2=30
.D C^%DTC
.S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*289 MT WORKLOAD CLEANUP "_$S(I="MT-IY":"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 processing
; Write message to installation device and to INSTALL file (#9.7)
D BMES^XPDUTL("MT Workload Clean-Up Processing")
D MES^XPDUTL("Once the MT Workload Clean-Up has completed, a mail ")
D MES^XPDUTL("message will be sent that will report the number of")
D MES^XPDUTL("records, by income year, that were changed.")
D MES^XPDUTL("Additionally, the report will contain notes about any")
D MES^XPDUTL("errors encountered during the MT Workload Clean-Up.")
D BMES^XPDUTL("Beginning clean-up process "_$$FMTE^XLFDT($$NOW^XLFDT))
;
RECCHK ; Process Control Body
N DGMTIDT,DGDFN,STA,YR,FILERR,MTIEN,MTSTAT,ARR,ERRS,LSTMT
;
; Only look at records where the Income Year is 1998 or 1999
;
I '$D(XPDNM) S DGDFN=""
I $D(XPDNM) S DGDFN=$$PARCP^XPDUTL("DGDFN")
S STA=$P($$SITE^VASITE,"^",3)
;
F S DGDFN=$O(^DGMT(408.31,"AID",1,DGDFN)) Q:DGDFN="" D
.S DGMTIDT=-DT
.K ARR
.F S DGMTIDT=$O(^DGMT(408.31,"AID",1,DGDFN,DGMTIDT)) Q:DGMTIDT=""!(DGMTIDT>-2990101) D
..; If there is a Primary in this year, skip the rest of this year.
..S LSTMT="",LSTMT=$$LST^DGMTU(DGDFN,$E(DGMTIDT,2,4)_"1231")
..I $E($P(LSTMT,U,2),2,3)=$E(DGMTIDT,3,4) S DGMTIDT=$E(DGMTIDT,1,4)_"0101" Q
..S (MTSTAT,MTIEN)=""
..F S MTIEN=$O(^DGMT(408.31,"AID",1,DGDFN,DGMTIDT,MTIEN)) Q:MTIEN="" D
...; If the MT Status is not CAT A or CAT C, Quit.
...S MTSTAT=$P($G(^DGMT(408.31,MTIEN,0)),U,3)
...I MTSTAT'=4,MTSTAT'=6 Q
...; Setup an array with Patient's Means Test info
...D SETARR
.S FILERR=0
.D CHKREC(DGDFN)
;
; Send a mailman msg to the user with the results
D MAIL^DG53289M
I $D(XPDNM) S %=$$COMCP^XPDUTL("DGDFN")
D MES^XPDUTL(" >>clean-up process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
Q
;
SETARR ; Setup an array with Means Test info
N IYR
; If the data was purged, don't use the record.
I $D(^DGMT(408.31,MTIEN,"PURGE")) Q
;
S IYR=$E(DGMTIDT,2,4)
S:'$D(ARR(DGDFN,IYR)) ARR(DGDFN,IYR)=0
S ARR(DGDFN,IYR,MTIEN,-DGMTIDT)=""
S ARR(DGDFN,IYR)=ARR(DGDFN,IYR)+1
; Identify records where HEC is the source of the Income Test
I $P(^DGMT(408.31,MTIEN,0),U,23)=2 S ARR(DGDFN,IYR,"IVM")=MTIEN
Q
;
CHKREC(DGDFN) ; Validate each year by the earliest record
N INCYR,REC31
S INCYR=""
F S INCYR=$O(ARR(DGDFN,INCYR)) Q:INCYR="" D
.S REC31=""
.I ARR(DGDFN,INCYR)=1 S REC31=$O(ARR(DGDFN,INCYR,""))
.I ARR(DGDFN,INCYR)>1 D
..I $D(ARR(DGDFN,INCYR,"IVM")) S REC31=ARR(DGDFN,INCYR,"IVM")
..I '$D(ARR(DGDFN,INCYR,"IVM")) S REC31=$O(ARR(DGDFN,INCYR,""))
.; Only set the records that meet all the criteria
.D:REC31 SETREC(INCYR,REC31,.ERRS)
.; If there was an error, update temp global
.I FILERR M ^XTMP("DG-MT-ERR")=ERRS K ERRS
.; Update check point with Patient ID
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGDFN",DGDFN)
.; Cleanup the array when finished
.K ARR(DGDFN,INCYR)
Q
;
SETREC(IY,REC31,ERRS) ; The record met all criteria, now set the PRIMARY
;
N DATA,ERROR
; Increment Processed Record Count for Income Year
D COUNT(IY)
S DATA(2)=1
I '$$UPD^DGENDBS(408.31,.REC31,.DATA,.ERROR) D
.S ERRS(408.31,REC31,"PRIM")="Unable to process record",FILERR=1 Q
Q
;
COUNT(DATE) ; Update process tracking counter
; Input:
; DATE = inverse of the date from "AID" x-ref in 408.31
;
S IY=DATE-1
S ^XTMP("DG-MT-IY",IY)=+$G(^XTMP("DG-MT-IY",IY))+1
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53289 4603 printed Dec 13, 2024@02:37 Page 2
DG53289 ;ALB/RMM - Means Test Workload Cleanup Utility ; 23 Aug 2000 7:00 AM
+1 ;;5.3;Registration;**289**;Aug 23, 2000
+2 ;
+3 ; This is a cleanup program for the MT Workload Cleanup
+4 ; corected with Patch #DG*5.3*267.
+5 ;
+6 ; The clean up is required as there is a number of entries in the
+7 ; Annual Means Test file (408.31) that have no records set as primary.
+8 ;
+9 ;
+10 ; ^XTMP("DG-MT-IY",MTIY) track number of records processed:
+11 ; ^XTMP("DG-MT-ERR") contains error messages returned from FM DBS calls:
+12 ; ^XTMP("DG-MT-ERR",file#,record#,field#,n)=error message
+13 ;
PRE ;
+1 ; Pre-install set up checkpoint and tracking global...
+2 NEW %,I,X,X1,X2
+3 IF $DATA(XPDNM)
Begin DoDot:1
+4 ; Checkpoint
+5 IF $$VERCP^XPDUTL("DGDFN")'>0
Begin DoDot:2
+6 SET %=$$NEWCP^XPDUTL("DGDFN","",0)
End DoDot:2
End DoDot:1
+7 ;
+8 ; Initialize tracking global (See text above for description)
+9 FOR I="MT-IY","MT-ERR"
Begin DoDot:1
+10 IF $DATA(^XTMP("DG-"_I))
QUIT
+11 SET X1=DT
+12 SET X2=30
+13 DO C^%DTC
+14 SET ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*289 MT WORKLOAD CLEANUP "_$S(I="MT-IY":"record count",1:"filing errors")
End DoDot:1
+15 ;
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 processing
+1 ; Write message to installation device and to INSTALL file (#9.7)
+2 DO BMES^XPDUTL("MT Workload Clean-Up Processing")
+3 DO MES^XPDUTL("Once the MT Workload Clean-Up has completed, a mail ")
+4 DO MES^XPDUTL("message will be sent that will report the number of")
+5 DO MES^XPDUTL("records, by income year, that were changed.")
+6 DO MES^XPDUTL("Additionally, the report will contain notes about any")
+7 DO MES^XPDUTL("errors encountered during the MT Workload Clean-Up.")
+8 DO BMES^XPDUTL("Beginning clean-up process "_$$FMTE^XLFDT($$NOW^XLFDT))
+9 ;
RECCHK ; Process Control Body
+1 NEW DGMTIDT,DGDFN,STA,YR,FILERR,MTIEN,MTSTAT,ARR,ERRS,LSTMT
+2 ;
+3 ; Only look at records where the Income Year is 1998 or 1999
+4 ;
+5 IF '$DATA(XPDNM)
SET DGDFN=""
+6 IF $DATA(XPDNM)
SET DGDFN=$$PARCP^XPDUTL("DGDFN")
+7 SET STA=$PIECE($$SITE^VASITE,"^",3)
+8 ;
+9 FOR
SET DGDFN=$ORDER(^DGMT(408.31,"AID",1,DGDFN))
if DGDFN=""
QUIT
Begin DoDot:1
+10 SET DGMTIDT=-DT
+11 KILL ARR
+12 FOR
SET DGMTIDT=$ORDER(^DGMT(408.31,"AID",1,DGDFN,DGMTIDT))
if DGMTIDT=""!(DGMTIDT>-2990101)
QUIT
Begin DoDot:2
+13 ; If there is a Primary in this year, skip the rest of this year.
+14 SET LSTMT=""
SET LSTMT=$$LST^DGMTU(DGDFN,$EXTRACT(DGMTIDT,2,4)_"1231")
+15 IF $EXTRACT($PIECE(LSTMT,U,2),2,3)=$EXTRACT(DGMTIDT,3,4)
SET DGMTIDT=$EXTRACT(DGMTIDT,1,4)_"0101"
QUIT
+16 SET (MTSTAT,MTIEN)=""
+17 FOR
SET MTIEN=$ORDER(^DGMT(408.31,"AID",1,DGDFN,DGMTIDT,MTIEN))
if MTIEN=""
QUIT
Begin DoDot:3
+18 ; If the MT Status is not CAT A or CAT C, Quit.
+19 SET MTSTAT=$PIECE($GET(^DGMT(408.31,MTIEN,0)),U,3)
+20 IF MTSTAT'=4
IF MTSTAT'=6
QUIT
+21 ; Setup an array with Patient's Means Test info
+22 DO SETARR
End DoDot:3
End DoDot:2
+23 SET FILERR=0
+24 DO CHKREC(DGDFN)
End DoDot:1
+25 ;
+26 ; Send a mailman msg to the user with the results
+27 DO MAIL^DG53289M
+28 IF $DATA(XPDNM)
SET %=$$COMCP^XPDUTL("DGDFN")
+29 DO MES^XPDUTL(" >>clean-up process completed "_$$FMTE^XLFDT($$NOW^XLFDT))
+30 QUIT
+31 ;
SETARR ; Setup an array with Means Test info
+1 NEW IYR
+2 ; If the data was purged, don't use the record.
+3 IF $DATA(^DGMT(408.31,MTIEN,"PURGE"))
QUIT
+4 ;
+5 SET IYR=$EXTRACT(DGMTIDT,2,4)
+6 if '$DATA(ARR(DGDFN,IYR))
SET ARR(DGDFN,IYR)=0
+7 SET ARR(DGDFN,IYR,MTIEN,-DGMTIDT)=""
+8 SET ARR(DGDFN,IYR)=ARR(DGDFN,IYR)+1
+9 ; Identify records where HEC is the source of the Income Test
+10 IF $PIECE(^DGMT(408.31,MTIEN,0),U,23)=2
SET ARR(DGDFN,IYR,"IVM")=MTIEN
+11 QUIT
+12 ;
CHKREC(DGDFN) ; Validate each year by the earliest record
+1 NEW INCYR,REC31
+2 SET INCYR=""
+3 FOR
SET INCYR=$ORDER(ARR(DGDFN,INCYR))
if INCYR=""
QUIT
Begin DoDot:1
+4 SET REC31=""
+5 IF ARR(DGDFN,INCYR)=1
SET REC31=$ORDER(ARR(DGDFN,INCYR,""))
+6 IF ARR(DGDFN,INCYR)>1
Begin DoDot:2
+7 IF $DATA(ARR(DGDFN,INCYR,"IVM"))
SET REC31=ARR(DGDFN,INCYR,"IVM")
+8 IF '$DATA(ARR(DGDFN,INCYR,"IVM"))
SET REC31=$ORDER(ARR(DGDFN,INCYR,""))
End DoDot:2
+9 ; Only set the records that meet all the criteria
+10 if REC31
DO SETREC(INCYR,REC31,.ERRS)
+11 ; If there was an error, update temp global
+12 IF FILERR
MERGE ^XTMP("DG-MT-ERR")=ERRS
KILL ERRS
+13 ; Update check point with Patient ID
+14 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGDFN",DGDFN)
+15 ; Cleanup the array when finished
+16 KILL ARR(DGDFN,INCYR)
End DoDot:1
+17 QUIT
+18 ;
SETREC(IY,REC31,ERRS) ; The record met all criteria, now set the PRIMARY
+1 ;
+2 NEW DATA,ERROR
+3 ; Increment Processed Record Count for Income Year
+4 DO COUNT(IY)
+5 SET DATA(2)=1
+6 IF '$$UPD^DGENDBS(408.31,.REC31,.DATA,.ERROR)
Begin DoDot:1
+7 SET ERRS(408.31,REC31,"PRIM")="Unable to process record"
SET FILERR=1
QUIT
End DoDot:1
+8 QUIT
+9 ;
COUNT(DATE) ; Update process tracking counter
+1 ; Input:
+2 ; DATE = inverse of the date from "AID" x-ref in 408.31
+3 ;
+4 SET IY=DATE-1
+5 SET ^XTMP("DG-MT-IY",IY)=+$GET(^XTMP("DG-MT-IY",IY))+1
+6 ;
+7 QUIT
