source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53672C.m@ 1306

Last change on this file since 1306 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1DG53672C ;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 ;
7QUE ; 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 ;
32FIND ; 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
Note: See TracBrowser for help on using the repository browser.