| 1 | DG53672C ;ALB/BRM,LBD,ERC;DG*5.3*672 CLEAN-UP UTILITIES ; 8/16/05 12:12pm
|
|---|
| 2 | ;;5.3;Registration;**672**;Aug 13,1993
|
|---|
| 3 | ;;
|
|---|
| 4 | ; This routine will be used to loop through Patient File (#2) entries
|
|---|
| 5 | ; and will call all necessary clean-up routines.
|
|---|
| 6 | ;
|
|---|
| 7 | QUE ; Que job to run
|
|---|
| 8 | N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
|
|---|
| 9 | ;
|
|---|
| 10 | D BMES^XPDUTL("This process will perform the following clean-up activities:")
|
|---|
| 11 | D BMES^XPDUTL(" 1) Find and delete all Reimbursable Insurance Other Eligibility")
|
|---|
| 12 | D MES^XPDUTL(" Codes on patients that are not deceased. A Mailman message")
|
|---|
| 13 | D MES^XPDUTL(" will be sent upon completion of this job containing a summary")
|
|---|
| 14 | D MES^XPDUTL(" of the clean-up results.")
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | D BMES^XPDUTL(" 2) Convert data in Patient file field 1010.58, Disability Discharge on 1010EZ")
|
|---|
| 18 | D MES^XPDUTL(" to the corresponding value in field .3603, Discharge Due to Disability.")
|
|---|
| 19 | D MES^XPDUTL(" Convert data in Patient file field .362, Disability Ret. from Military")
|
|---|
| 20 | D MES^XPDUTL(" if the value is 1 or 2 to a 1 (YES) in field .3602, Military Disability")
|
|---|
| 21 | D MES^XPDUTL(" Retirement and field .3603, Discharge Due to Disability.")
|
|---|
| 22 | ;
|
|---|
| 23 | D MES^XPDUTL(" ")
|
|---|
| 24 | ;
|
|---|
| 25 | S ZTRTN="FIND^DG53672C",ZTIO="",ZTDTH=$$NOW^XLFDT()
|
|---|
| 26 | S ZTDESC="DG*5.3*672 CLEAN-UP PROCESSES"
|
|---|
| 27 | D ^%ZTLOAD,HOME^%ZIS
|
|---|
| 28 | I '$G(ZTSK) D BMES^XPDUTL("Clean-up was not tasked.") Q
|
|---|
| 29 | D BMES^XPDUTL("Clean-up has been tasked as Task #"_ZTSK)
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | FIND ; entry point
|
|---|
| 33 | ;
|
|---|
| 34 | N DFN,RIELIG,X1,X2,X
|
|---|
| 35 | ;
|
|---|
| 36 | K ^XTMP("DG53672C")
|
|---|
| 37 | S X1=DT,X2=90 D C^%DTC
|
|---|
| 38 | S ^XTMP("DG53672C",0)=X_"^"_$$NOW^XLFDT_"^DG*5.3*672 CLEAN-UP JOBS"
|
|---|
| 39 | S ^XTMP("DG53672C",0,"TASK")=$G(ZTSK)
|
|---|
| 40 | ; Reimbursible Other EC Clean-up Process Setup
|
|---|
| 41 | D RSETUP^DG53672R(.RIELIG)
|
|---|
| 42 | ;
|
|---|
| 43 | S DFN=0
|
|---|
| 44 | F S DFN=$O(^DPT(DFN)) Q:'DFN D
|
|---|
| 45 | .S ^XTMP("DG53672C","TCNT")=$G(^XTMP("DG53672C","TCNT"))+1
|
|---|
| 46 | .;
|
|---|
| 47 | .; process reimbursable insurance other EC deletions
|
|---|
| 48 | .D REIM^DG53672R(DFN,.RIELIG)
|
|---|
| 49 | .;
|
|---|
| 50 | .;convert Disability Discharge on 1010EZ
|
|---|
| 51 | .D EN^DG53672D(DFN)
|
|---|
| 52 | ;
|
|---|
| 53 | S $P(^XTMP("DG53672C",0),"^",4)=$$NOW^XLFDT
|
|---|
| 54 | ;
|
|---|
| 55 | ; send message for Reimbursable Insur. Job
|
|---|
| 56 | D SNDMSG^DG53672R
|
|---|
| 57 | ;send message for disability discharge data conversion
|
|---|
| 58 | D SNDMSG^DG53672D
|
|---|
| 59 | Q
|
|---|
