source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS155P1.m@ 767

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1EAS155P1 ;;ALB/SCK - MT LETTERS BAD POINTERS CLEAN UP ;07/22/2004
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**55**;MAR 15,2001
3 ;
4 ; This routine was initally run as the post-install for patch EAS*1*55
5 ; Running this routine from programmer mode will initiate another
6 ; reporting cycle. You should not run this routine unless advised
7 ; by customer support.
8 Q
9 ;
10EN ; Entry point from programmer mode
11 N MSG,XCNT,DIR,X,Y,DIRUT
12 ;
13 F XCNT=1:1 S LINE=$P($T(TEXT+XCNT),";;",2) Q:LINE="$$END" S MSG(XCNT)=LINE
14 W @IOF
15 S XCNT=0 F S XCNT=$O(MSG(XCNT)) Q:'XCNT W !?3,MSG(XCNT)
16 W !
17 I '$$CHKPREV Q
18 ;
19 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Continue with scan"
20 S DIR("?")="Press ENTER to continue, enter ""NO"" to exit."
21 D ^DIR K DIR
22 I Y D QUE Q
23 W !?3,"Exiting scan..."
24 Q
25 ;
26QUE ;
27 K ZTRTN,ZTDESC,ZTSAVE
28 S ZTRTN="BLD^EAS155P1"
29 S ZTDESC="EAS MT LTR BAD PTR SCAN"
30 S ZTSAVE("DUZ")=""
31 S ZTIO=""
32 D ^%ZTLOAD
33 I $D(ZTSK)[0 D
34 . W:'$G(EASQ) !!?3,"Scan canceled"
35 E D
36 . I $G(EASQ) D BMES^XPDUTL("Scan Queued: "_ZTSK)
37 . E W !!?3,"Scan Queued: "_ZTSK
38 Q
39 ;
40BLD ; Entry point scan and cleanup. Do not call directly, call from the EN entry point.
41 D SCAN,CLNUP,ALERT
42 S ^XTMP("EASBADPTRS",0,"END")=$H
43 Q
44 ;
45POST ; Post Install entry point. This entry point is intended to be called from the KIDS build.
46 N MSG,XCNT,EASQ
47 ;
48 F XCNT=1:1 S LINE=$P($T(TEXT+XCNT),";;",2) Q:LINE="$$END" D
49 . S MSG(XCNT)=LINE
50 D MES^XPDUTL(.MSG)
51 S EASQ=1 D QUE
52 Q
53 ;
54SCAN ; Begin scanning for any bad pointers in the MT Letter Files
55 N EAIEN
56 ;
57 K ^XTMP("EASBADPTRS")
58 S ^XTMP("EASBADPTRS",0)=$$FMADD^XLFDT($$DT^XLFDT,30)_U_$$DT^XLFDT_U_"EAS MT LETTERS BAD POINTERS SCAN"
59 S ^XTMP("EASBADPTRS",0,"START")=$H,^XTMP("EASBADPTRS",0,"DUZ")=DUZ
60 S EAIEN=0
61 F S EAIEN=$O(^EAS(713.2,"AC",0,EAIEN)) Q:'EAIEN D
62 . I $$GET1^DIQ(713.2,EAIEN,2)']"" S ^XTMP("EASBADPTRS",EAIEN)=""
63 S ^XTMP("EASBADPTRS",0,"SCAN COMPLETE")=$H
64 Q
65 ;
66CLNUP ; Disable letters in MT Letter Status file with suspicious pointers
67 ; Do not delete, but flag as "bad"
68 N EAIEN,EAFDA,ERR,DIE,DA,DR
69 ;
70 S EAIEN=0
71 F S EAIEN=$O(^XTMP("EASBADPTRS",EAIEN)) Q:'EAIEN D
72 . S DIE="^EAS(713.2,",DA=EAIEN
73 . S DR="4///YES;5///TODAY;6////.5;7///LETTER DISABLED, BAD POINTERS?;9///NO;12///NO;18///NO"
74 . D ^DIE K DIE,DR,DA
75 ;
76 S ^XTMP("EASBADPTRS",0,"CLEANUP COMPLETE")=$H
77 Q
78 ;
79ALERT ; Send an alert to user that the scan has completed.
80 K XQA,XQAMSG,XQAOPT,XQAROU,XQAID,XQDATA,XQAFLAG
81 ;
82 S XQA(DUZ)="",XQAID="EAS",XQAROU="REPORT^EAS155P1"
83 S XQAMSG="EAS MT LTRs Bad Pointers Scan Complete, Print Report"
84 D SETUP^XQALERT
85 Q
86 ;
87REPORT ; Print Bad Pointers Report setup
88 K ZTSAVE S ZTSAVE("DUZ")=""
89 D EN^XUTMDEVQ("P^EAS155P1","Print EAS Bad Pointers Report",.ZTSAVE)
90 Q
91 ;
92P ; Print report
93 N LINE,EAIEN,PAGE,EAX,DFN
94 ;
95 S (PAGE,EAIEN)=0
96 D HDR
97 F S EAIEN=$O(^XTMP("EASBADPTRS",EAIEN)) Q:'EAIEN D Q:$G(EASABRT)
98 . S LINE=""
99 . S LINE=$$SETSTR^VALM1(EAIEN,"",20,15)
100 . S EAX=$$GET1^DIQ(713.2,EAIEN,2,"I")
101 . S LINE=$$SETSTR^VALM1(EAX,LINE,40,15)
102 . S DFN=$$GET1^DIQ(713.1,EAX,.01,"I")
103 . S LINE=$$SETSTR^VALM1(DFN,LINE,60,15)
104 . W !,LINE
105 . I $Y+5>IOSL D Q:$G(EASABRT)
106 . . I $E(IOST,1,2)="C-" D Q:$G(EASABRT)
107 . . . S DIR(0)="E" D ^DIR K DIR
108 . . . I 'Y S EASABRT=1 Q
109 . . D HDR
110 Q
111 ;
112HDR ; PRINT REPORT HEADER
113 N LINE,DDASH,TEXT,TEXT1
114 ;
115 S PAGE=PAGE+1
116 W:$E(IOST,1,2)="C-" @IOF
117 W "Results of Possible Bad Pointers Report for EAS MT Letters"
118 S TEXT="Date Scan Run: "_$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"END"))
119 S TEXT1="Run by: "_$$GET1^DIQ(200,^XTMP("EASBADPTRS",0,"DUZ"),.01)
120 S SPACE=(IOM-($L(TEXT)+$L(TEXT1)))
121 S $P(LINE," ",SPACE-2)=""
122 W !,TEXT,LINE,TEXT1
123 ;
124 S TEXT="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
125 S TEXT1="Page: "_PAGE
126 S SPACE=(IOM-($L(TEXT)+$L(TEXT1)))
127 S $P(LINE," ",SPACE-2)=""
128 W !,TEXT,LINE,TEXT1,!
129 ;
130 S $P(DDASH,"=",IOM-10)=""
131 S LINE=$$SETSTR^VALM1("File IEN's","",5,12)
132 S LINE=$$SETSTR^VALM1("713.2",LINE,20,5)
133 S LINE=$$SETSTR^VALM1("713.1",LINE,40,5)
134 S LINE=$$SETSTR^VALM1("DFN",LINE,60,5)
135 W !,LINE
136 W !?5,DDASH
137 Q
138 ;
139CHKPREV() ; Check for a previous scan in XTMP
140 N RSLT,EASDUZ
141 ;
142 S RSLT=1
143 I $D(^XTMP("EASBADPTRS")) D
144 . I '$D(^XTMP("EASBADPTRS",0,"END")) D
145 . . W !?3,$CHAR(7),"The EAS MT LTRs Bad Pointer scan is currently running."
146 . . S EASDUZ=$G(^XTMP("EASBADPTRS",0,"DUZ"))
147 . . I EASDUZ>0 W !?3,"started by ",$$GET1^DIQ(200,EASDUZ,.01)
148 . . I $D(^XTMP("EASBADPTRS",0,"START")) W " on ",$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"START"))
149 . . S RSLT=0
150 . E D
151 . . W !?3,"Data from a previous scan exists. "
152 . . I $D(^XTMP("EASBADPTRS",0,"END")) W "Last Run: ",$$HTE^XLFDT(^XTMP("EASBADPTRS",0,"END"))
153 . . W !?3,"Answering ""YES"" will cause this data to be erased and a new"
154 . . W !?3,"scan started!",!
155 Q $G(RSLT)
156 ;
157TEXT ;
158 ;;Running this routine will scan the EAS MT PATIENT STATUS File (#713.1)
159 ;;and the EAS MT LETTER STATUS File (#713.2) for any bad pointers
160 ;;linking to the PATIENT File (#2). This routine WILL NOT clean up
161 ;;these pointers, but will flag the appropriate MT Letter entry as
162 ;;'MT RETURNED' and enter a comment of 'Bad Pointer'. Your local
163 ;;IRM may take additional cleanup actions.
164 ;;
165 ;;Data from this scan will be retained in the ^XTMP("EASBADPTRS")
166 ;;global for 30 days. You may run REPORT^EAS155P1 at a programmer
167 ;;prompt to re-print a formatted report. You will be alerted when the
168 ;;scan is complete.
169 ;;$$END
170 Q
Note: See TracBrowser for help on using the repository browser.