DG53672C ;ALB/BRM,LBD,ERC;DG*5.3*672 CLEAN-UP UTILITIES ; 8/16/05 12:12pm
;;5.3;Registration;**672**;Aug 13,1993
;;
; This routine will be used to loop through Patient File (#2) entries
; and will call all necessary clean-up routines.
;
QUE ; Que job to run
N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
;
D BMES^XPDUTL("This process will perform the following clean-up activities:")
D BMES^XPDUTL(" 1) Find and delete all Reimbursable Insurance Other Eligibility")
D MES^XPDUTL(" Codes on patients that are not deceased. A Mailman message")
D MES^XPDUTL(" will be sent upon completion of this job containing a summary")
D MES^XPDUTL(" of the clean-up results.")
;
;
D BMES^XPDUTL(" 2) Convert data in Patient file field 1010.58, Disability Discharge on 1010EZ")
D MES^XPDUTL(" to the corresponding value in field .3603, Discharge Due to Disability.")
D MES^XPDUTL(" Convert data in Patient file field .362, Disability Ret. from Military")
D MES^XPDUTL(" if the value is 1 or 2 to a 1 (YES) in field .3602, Military Disability")
D MES^XPDUTL(" Retirement and field .3603, Discharge Due to Disability.")
;
D MES^XPDUTL(" ")
;
S ZTRTN="FIND^DG53672C",ZTIO="",ZTDTH=$$NOW^XLFDT()
S ZTDESC="DG*5.3*672 CLEAN-UP PROCESSES"
D ^%ZTLOAD,HOME^%ZIS
I '$G(ZTSK) D BMES^XPDUTL("Clean-up was not tasked.") Q
D BMES^XPDUTL("Clean-up has been tasked as Task #"_ZTSK)
Q
;
FIND ; entry point
;
N DFN,RIELIG,X1,X2,X
;
K ^XTMP("DG53672C")
S X1=DT,X2=90 D C^%DTC
S ^XTMP("DG53672C",0)=X_"^"_$$NOW^XLFDT_"^DG*5.3*672 CLEAN-UP JOBS"
S ^XTMP("DG53672C",0,"TASK")=$G(ZTSK)
; Reimbursible Other EC Clean-up Process Setup
D RSETUP^DG53672R(.RIELIG)
;
S DFN=0
F S DFN=$O(^DPT(DFN)) Q:'DFN D
.S ^XTMP("DG53672C","TCNT")=$G(^XTMP("DG53672C","TCNT"))+1
.;
.; process reimbursable insurance other EC deletions
.D REIM^DG53672R(DFN,.RIELIG)
.;
.;convert Disability Discharge on 1010EZ
.D EN^DG53672D(DFN)
;
S $P(^XTMP("DG53672C",0),"^",4)=$$NOW^XLFDT
;
; send message for Reimbursable Insur. Job
D SNDMSG^DG53672R
;send message for disability discharge data conversion
D SNDMSG^DG53672D
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53672C 2221 printed Sep 23, 2025@20:14:07 Page 2
DG53672C ;ALB/BRM,LBD,ERC;DG*5.3*672 CLEAN-UP UTILITIES ; 8/16/05 12:12pm
+1 ;;5.3;Registration;**672**;Aug 13,1993
+2 ;;
+3 ; This routine will be used to loop through Patient File (#2) entries
+4 ; and will call all necessary clean-up routines.
+5 ;
QUE ; Que job to run
+1 NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
+2 ;
+3 DO BMES^XPDUTL("This process will perform the following clean-up activities:")
+4 DO BMES^XPDUTL(" 1) Find and delete all Reimbursable Insurance Other Eligibility")
+5 DO MES^XPDUTL(" Codes on patients that are not deceased. A Mailman message")
+6 DO MES^XPDUTL(" will be sent upon completion of this job containing a summary")
+7 DO MES^XPDUTL(" of the clean-up results.")
+8 ;
+9 ;
+10 DO BMES^XPDUTL(" 2) Convert data in Patient file field 1010.58, Disability Discharge on 1010EZ")
+11 DO MES^XPDUTL(" to the corresponding value in field .3603, Discharge Due to Disability.")
+12 DO MES^XPDUTL(" Convert data in Patient file field .362, Disability Ret. from Military")
+13 DO MES^XPDUTL(" if the value is 1 or 2 to a 1 (YES) in field .3602, Military Disability")
+14 DO MES^XPDUTL(" Retirement and field .3603, Discharge Due to Disability.")
+15 ;
+16 DO MES^XPDUTL(" ")
+17 ;
+18 SET ZTRTN="FIND^DG53672C"
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
+19 SET ZTDESC="DG*5.3*672 CLEAN-UP PROCESSES"
+20 DO ^%ZTLOAD
DO HOME^%ZIS
+21 IF '$GET(ZTSK)
DO BMES^XPDUTL("Clean-up was not tasked.")
QUIT
+22 DO BMES^XPDUTL("Clean-up has been tasked as Task #"_ZTSK)
+23 QUIT
+24 ;
FIND ; entry point
+1 ;
+2 NEW DFN,RIELIG,X1,X2,X
+3 ;
+4 KILL ^XTMP("DG53672C")
+5 SET X1=DT
SET X2=90
DO C^%DTC
+6 SET ^XTMP("DG53672C",0)=X_"^"_$$NOW^XLFDT_"^DG*5.3*672 CLEAN-UP JOBS"
+7 SET ^XTMP("DG53672C",0,"TASK")=$GET(ZTSK)
+8 ; Reimbursible Other EC Clean-up Process Setup
+9 DO RSETUP^DG53672R(.RIELIG)
+10 ;
+11 SET DFN=0
+12 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+13 SET ^XTMP("DG53672C","TCNT")=$GET(^XTMP("DG53672C","TCNT"))+1
+14 ;
+15 ; process reimbursable insurance other EC deletions
+16 DO REIM^DG53672R(DFN,.RIELIG)
+17 ;
+18 ;convert Disability Discharge on 1010EZ
+19 DO EN^DG53672D(DFN)
End DoDot:1
+20 ;
+21 SET $PIECE(^XTMP("DG53672C",0),"^",4)=$$NOW^XLFDT
+22 ;
+23 ; send message for Reimbursable Insur. Job
+24 DO SNDMSG^DG53672R
+25 ;send message for disability discharge data conversion
+26 DO SNDMSG^DG53672D
+27 QUIT
