- 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 Jan 18, 2025@03:37:42 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