- 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 Jan 18, 2025@03:38:58 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