Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53289

DG53289.m

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