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

DG53672C.m

Go to the documentation of this file.
  1. 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
  1. ;;
  1. ; This routine will be used to loop through Patient File (#2) entries
  1. ; and will call all necessary clean-up routines.
  1. ;
  1. QUE ; Que job to run
  1. N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
  1. ;
  1. D BMES^XPDUTL("This process will perform the following clean-up activities:")
  1. D BMES^XPDUTL(" 1) Find and delete all Reimbursable Insurance Other Eligibility")
  1. D MES^XPDUTL(" Codes on patients that are not deceased. A Mailman message")
  1. D MES^XPDUTL(" will be sent upon completion of this job containing a summary")
  1. D MES^XPDUTL(" of the clean-up results.")
  1. ;
  1. ;
  1. D BMES^XPDUTL(" 2) Convert data in Patient file field 1010.58, Disability Discharge on 1010EZ")
  1. D MES^XPDUTL(" to the corresponding value in field .3603, Discharge Due to Disability.")
  1. D MES^XPDUTL(" Convert data in Patient file field .362, Disability Ret. from Military")
  1. D MES^XPDUTL(" if the value is 1 or 2 to a 1 (YES) in field .3602, Military Disability")
  1. D MES^XPDUTL(" Retirement and field .3603, Discharge Due to Disability.")
  1. ;
  1. D MES^XPDUTL(" ")
  1. ;
  1. S ZTRTN="FIND^DG53672C",ZTIO="",ZTDTH=$$NOW^XLFDT()
  1. S ZTDESC="DG*5.3*672 CLEAN-UP PROCESSES"
  1. D ^%ZTLOAD,HOME^%ZIS
  1. I '$G(ZTSK) D BMES^XPDUTL("Clean-up was not tasked.") Q
  1. D BMES^XPDUTL("Clean-up has been tasked as Task #"_ZTSK)
  1. Q
  1. ;
  1. FIND ; entry point
  1. ;
  1. N DFN,RIELIG,X1,X2,X
  1. ;
  1. K ^XTMP("DG53672C")
  1. S X1=DT,X2=90 D C^%DTC
  1. S ^XTMP("DG53672C",0)=X_"^"_$$NOW^XLFDT_"^DG*5.3*672 CLEAN-UP JOBS"
  1. S ^XTMP("DG53672C",0,"TASK")=$G(ZTSK)
  1. ; Reimbursible Other EC Clean-up Process Setup
  1. D RSETUP^DG53672R(.RIELIG)
  1. ;
  1. S DFN=0
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. .S ^XTMP("DG53672C","TCNT")=$G(^XTMP("DG53672C","TCNT"))+1
  1. .;
  1. .; process reimbursable insurance other EC deletions
  1. .D REIM^DG53672R(DFN,.RIELIG)
  1. .;
  1. .;convert Disability Discharge on 1010EZ
  1. .D EN^DG53672D(DFN)
  1. ;
  1. S $P(^XTMP("DG53672C",0),"^",4)=$$NOW^XLFDT
  1. ;
  1. ; send message for Reimbursable Insur. Job
  1. D SNDMSG^DG53672R
  1. ;send message for disability discharge data conversion
  1. D SNDMSG^DG53672D
  1. Q