source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTL1.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1EASMTL1 ;MIN/TCM ALB/SCK/AEG/PHH - AUTOMATED MEANS TEST LETTER - PATIENT SEARCH ; 07/2/01
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,20,54**;MAR 15,2001
3 ; Conversion from class III software
4 ;
5QUEUE ; Main entry point for tasked (background) letter search
6 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZDATE
7 ;
8 S ZTRTN="EN^EASMTL1"
9 S ZTDESC="AUTOMATED MT LETTERS GENERATOR"
10 S (ZTDTH,ZDATE)=$$NOW^XLFDT
11 S ZTIO=""
12 D ^%ZTLOAD
13 Q
14 ;
15SETDT(EASRUN) ;
16 ; Input
17 ; EASRUN - Default start date for processing
18 ;
19 ; Output
20 ; 1 - Ok
21 ; 0 - Quit
22 ; EASRUN - Accepted start date for processing
23 ;
24 N DIR,DIRUT,RSLT
25 ;
26 S DIR("A",1)="The prior processing date is not available. A default date"
27 S DIR("A",2)="of "_$$FMTE^XLFDT(EASRUN)_" will be used."
28 S DIR("A")="Ok to continue? "
29 S DIR(0)="YAO",DIR("B")="YES"
30 D ^DIR K DIR
31 I $D(DIRUT) Q 0
32 Q:Y Y
33 ;
34 S DIR(0)="DAO^:DT:EX",DIR("B")=$$FMTE^XLFDT(EASRUN)
35 S DIR("?")="^D HELP^%DTC"
36 S DIR("A",1)=""
37 S DIR("A")="Select new start date: "
38 D ^DIR K DIR
39 I $D(DIRUT) Q 0
40 S EASRUN=Y
41 Q 1
42 ;
43EN ; Main entry point for processing
44 N EASLAST,X,EASLST,EASABRT,EASN,EAS6CNT,EAS3CNT,EAS0CNT,EASDT,EASDTFLG,EADT,MSG,EASX
45 ;
46 ; Get last processing date, default to TODAY - 30 if date not available
47 S EASX=$$GET1^DIQ(713,1,2,"I")
48 S EADT=$$DT^XLFDT
49 ; If letter search has already been run for TODAY, quit
50 I EASX=EADT D Q
51 . I '$D(ZTQUEUED) D
52 . . W !!,$CHAR(7),">> The Means Test Letter search has been run for today.",!
53 . . D PAUSE^EASMTUTL
54 ;
55 I EASX S EASLAST=$$FMADD^XLFDT(EASX,1)
56 I '$G(EASX) D Q:$G(EASABRT)
57 . S EASLAST=$$FMADD^XLFDT(DT,-30)
58 . I '$D(ZTQUEUED) S:'$$SETDT(.EASLAST) EASABRT=1
59 ;
60 ; Check lock on parameter file, one process at a time, quit if locked
61 I '$$LOCK^EASMTUTL(1) D Q
62 . I $D(ZTQUEUED) D Q
63 . . D ALERT^EASMTUTL("Auto MT Letters: This process is already running, "_$$FMTE^XLFDT(EADT,"2D"))
64 . W !!,$CHAR(7),"This process is already running, please try again later"
65 . D PAUSE^EASMTUTL
66 ;
67 D BLDLST(EASLAST,EADT) ; Build processing date list
68 D PROCESS ; Process dates
69 S EASX=$$LOCK^EASMTUTL(0)
70 D UPDPARAM(EADT)
71 D STATS(EASLAST,.EAS6CNT,EADT)
72 ;
73 I $D(ZTQUEUED) D
74 . S MSG="Auto-Letters Search completed: "_$$FMTE^XLFDT($$NOW^XLFDT)
75 . D ALERT^EASMTUTL(MSG)
76 Q
77 ;
78BLDLST(FRDT,TODT) ; Build processing date list
79 ; Input
80 ; FRDT - Beginning date for processing list
81 ; TODT - Ending date for processing list
82 ;
83 N EASN
84 ;
85 S EASN=FRDT,EASLST(FRDT)="",EASLST(TODT)=""
86 F S EASN=$$FMADD^XLFDT(EASN,1) Q:EASN>TODT S EASLST(EASN)=""
87 Q
88 ;
89PROCESS ; Get anniversary and threshold dates
90 N EASPRCDT
91 ;
92 S (EAS0CNT,EAS3CNT,EAS6CNT)=0
93 ; Calculate Anniverary date and 60/30/0 dates based on the Anniverary date
94 S EASPRCDT=0 ; Begin loop through processing dates
95 F S EASPRCDT=$O(EASLST(EASPRCDT)) Q:EASPRCDT'>0 D Q:$G(ZTSTOP) ; Quit if stop request
96 . K EASDT
97 . I '$D(ZTQUEUED) W !?5,">> Processing date "_$$FMTE^XLFDT(EASPRCDT)_" in progress <<",!
98 . ; Anniversary date is processing date minus one year plus sixty days
99 . ;
100 . S EASDT("ANV")=$$FMADD^XLFDT($$SUBLEAP^EASMTUTL(EASPRCDT),60) ; Anv date: 1 Year - 60 days
101 . S EASDT("60")=$$FMADD^XLFDT(EASDT("ANV"),(365-60)) ; Define 60 day letter print date
102 . S EASDT("30")=$$FMADD^XLFDT(EASDT("ANV"),(365-30)) ; Define 30 day letter print date
103 . S EASDT("0")=$$FMADD^XLFDT(EASDT("ANV"),365) ; Define 0 day letter print date
104 . ;
105 . ; Call the threshold date search
106 . D EN60^EASMTL2
107 . ; Check for stop request if queued
108 . I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1
109 Q
110 ;
111UPDPARAM(EASDT) ; Update the EAS Parameter file, #713
112 ; Input
113 ; EASDT - Today's date
114 ;
115 N DIE,DA,DR
116 ;
117 S DIE="^EAS(713,",DA=1,DR="2////^S X=EASDT"
118 S:'$D(ZTQUEUED) DR=DR_";3////^S X=DUZ;4////^S X=EASDT"
119 D ^DIE K DIE
120 Q
121 ;
122STATS(EASLAST,EAS6CNT,EASDT) ;Gather and print statistics
123 ; Input
124 ; EASLAST - Last date processed (Beginning date)
125 ; EAS6CNT - Array of 60 day letters
126 ; EASDT - Ending date of processing
127 ;
128 N MSG,EASD,LINE,TOT,XMSUB,XMY,XMTEXT,XMDUZ,ZDCD
129 ;
130 ; EAS*1*12 modification
131 S ZDCD=$S($$VERSION^XPDUTL("IVMC"):0,1:60)
132 ; **
133 ; EAS*1*20 modification
134 I $G(ZDCD)'>0,$G(DT)>3021014 S ZDCD=60
135 ;
136 S MSG(.1)="Automated Means Test Letter Generator Statistics"
137 S MSG(.2)="------------------------------------------------"
138 S MSG(.3)=""
139 S MSG(.4)="Beginning Processing Date: "_$$FMTE^XLFDT(EASLAST)
140 S MSG(.5)="Ending Processing Date: "_$$FMTE^XLFDT(EASDT)
141 S MSG(.6)=""
142 S MSG(11)=" "_ZDCD_"-day Letters: "_EAS6CNT
143 S MSG(16)=""
144 S LINE=18
145 ;
146 S LINE=LINE+1
147 S MSG(LINE)=ZDCD_" Day Letter Totals: "
148 S EASD=0
149 F S EASD=$O(EAS6CNT(EASD)) Q:'EASD D
150 . I +$G(EAS6CNT(EASD)) D
151 . . S LINE=LINE+1
152 . . S MSG(LINE)=" "_$$FMTE^XLFDT(EASD)_" : "_EAS6CNT(EASD)
153 ;
154 S XMSUB="AUTO MT LETTER RESULTS - "_$$FMTE^XLFDT(EASDT)
155 S XMTEXT="MSG("
156 S XMY("G.EAS MTLETTERS")=""
157 S XMDUZ="AUTOMATED MT LETTERS"
158 D ^XMD
159 Q
Note: See TracBrowser for help on using the repository browser.