source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACENV17.m@ 703

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1QACENV17 ;ALB/ERC - PRE-INSTALL ROUTINE FOR QAC*2*17 ;3/5/02
2 ;;2.0;Patient Representative;**17**;07/25/1995
3 ;
4 ;This pre-install routine will do several things. It will check
5 ;existing entries in the Customer Service Standard file (745.6) to
6 ;ensure that entries have not been added locally. If they have, the
7 ;site will get a message displayed indicating that installing will
8 ;overwrite the data. It will also check entries in the Issue Code
9 ;file (#745.2) looking for existing local Issue Codes that duplicate
10 ;the code of any entries that will be added with the pot-install. If
11 ;any duplications exist the site will have a message display.
12START ;
13 N X,XPDQUIT
14 S XPDQUIT=""
15 D CSS
16 D ISS
17 Q
18CSS ;check entries in 745.6
19 N QACQ
20 D INSTALL
21 Q:$G(QACQ)=1
22 N QAC,QACNAME,QACZERO
23 S QACNAME="Staff Courtesy^Timeliness^One Provider^Decisions^Emotional Needs^Coordination of Care^Patient Education^Family Involvement^Physical Comfort^Transitions"
24 S QAC=0
25 F S QAC=$O(^QA(745.6,QAC)) Q:QAC'>0!(QAC>10) D
26 . S QACZERO=^QA(745.6,QAC,0)
27 . I QAC'=$P(QACZERO,U) S QAC(QAC)=".01^"
28 . I $P(QACZERO,U,2)'=$P(QACNAME,U,QAC) S QAC(QAC)=$G(QAC(QAC))_"1"
29 ;if a different number of entries than the 10 exported previously
30 I $P(^QA(745.6,0),U,3,4)'="10^10" S QAC(0)=""
31 I $D(QAC(0))!($O(QAC(0))]"") D
32 . W !!!," ****NOTE****"
33 . W !,"The Customer Service Standard file (#745.6) has been altered locally."
34 . W !,"This file is pointed to by the Issue Code file (#745.2)."
35 . W !,"Before installation these pointers should be updated."
36 . W !!,"Current Customer Service Standards MUST be:"
37 . W !," ^QA(745.6,1,0) = 1^Staff Courtesy"
38 . W !," ^QA(745.6,2,0) = 2^Timeliness"
39 . W !," ^QA(745.6,3,0) = 3^One Provider"
40 . W !," ^QA(745.6,4,0) = 4^Decisions"
41 . W !," ^QA(745.6,5,0) = 5^Emotional Needs"
42 . W !," ^QA(745.6,6,0) = 6^Coordination of Care"
43 . W !," ^QA(745.6,7,0) = 7^Patient Education"
44 . W !," ^QA(745.6,8,0) = 8^Family Involvement"
45 . W !," ^QA(745.6,9,0) = 9^Physical Comfort"
46 . W !," ^QA(745.6,10,0) = 10^Transitions",!!
47 . W !,"Patch 17 will overwrite your data - editing of this file is not permitted."
48 . W !,"Installation of the patch will create changes in this file."
49 . N DIR,DIRUT,DIROUT
50 . S DIR(0)="YO"
51 . S DIR("A")="Do you want to continue with this installation"
52 . S DIR("B")="YES"
53 . ;S DIR("?")="Installing this patch will overwrite the data in your file 745.6. Proceed? "
54 . D ^DIR I $D(DIRUT)!($D(DIROUT)) Q
55 . I $E(X)="N"!($E(X)="n") S XPDQUIT=1 W !,"Installation stopped, global destroyed."
56 Q
57ISS ;check Issue Code entries for duplicate
58 N QACQ
59 D INSTALL
60 Q:$G(QACQ)=1
61 N QAC,QACCODE,QACE,QACIEN,QACPRE
62 S QACCODE="^SC^AC^OP^PR^EM^PC^CO^TR^FI^RI^LL^EV^RG^IF^CP^"
63 S QACIEN=0
64 S QAC=""
65 F S QAC=$O(^QA(745.2,"B",QAC)) Q:QAC']"" D
66 . S QACIEN=$O(^QA(745.2,"B",QAC,QACIEN)) Q:QACIEN'>0 D
67 . . S QACE="^"_$E(QAC,1,2)_"^"
68 . . I QACCODE[QACE D
69 . . . S QACPRE=$E(QAC,1,2)
70 . . . D CODE(QAC,QACPRE,.QACIEN)
71 I $O(QACIEN(0))>0 D MSG
72 Q
73CODE(QAC,QACPRE,QACIEN) ;
74 ;check for specific code, if a duplicate display message
75 N QACQUIT,QACR,QACTXT,QAX
76 Q:$G(QAC)']""
77 F QAX=1:1 S QACTXT=$P($T(@QACPRE+QAX),";;",2) Q:$G(QACTXT)']""!($G(QACQUIT)=1) D
78 . I $G(QAC)=$G(QACTXT) D
79 . . S QACIEN(QACIEN)=""
80 . . S QACQUIT=1
81 Q
82MSG ;
83 N QACND,QACR
84 S QACR=0
85 W !!!," ****NOTE****"
86 W !,"Your database has Issue Codes that duplicate those exported with this patch."
87 W !,"After installing this patch the following Issue Codes will refer to"
88 W !,"the new codes."
89 ;a message will display saying which codes will be affected
90 F S QACR=$O(QACIEN(QACR)) Q:QACR'>0 D
91 . S QACND=^QA(745.2,QACR,0)
92 . W !," "_$P(QACND,U)_" "_$P(QACND,U,3)
93 N DIRUT,DIROUT
94 S DIR(0)="YO"
95 S DIR("A")="Do you want to continue with this installation"
96 S DIR("B")="YES"
97 ;S DIR("?")="Installing this patch will change the entry in your file 745.2. Proceed? "
98 D ^DIR
99 I $E(X)="N"!($E(X)="n") S XPDQUIT=1 W !,"Installation stopped, global destroyed."
100 Q
101SC ;
102 ;;SC01
103 ;;SC02
104 Q
105AC ;
106 ;;AC01
107 ;;AC02
108 ;;AC03
109 ;;AC04
110 ;;AC05
111 ;;AC06
112 ;;AC07
113 ;;AC08
114 ;;AC09
115 ;;AC10
116 ;;AC11
117 ;;AC12
118 Q
119OP ;
120 ;;OP01
121 ;;OP02
122 Q
123PR ;
124 ;;PR01
125 ;;PR02
126 ;;PR03
127 ;;PR04
128 Q
129EM ;
130 ;;EM01
131 ;;EM02
132 ;;EM03
133 Q
134PC ;
135 ;;PC01
136 ;;PC02
137 Q
138CO ;
139 ;;CO01
140 ;;CO02
141 ;;CO03
142 ;;CO04
143 Q
144TR ;
145 ;;TR01
146 Q
147FI ;
148 ;;FI01
149 Q
150RI ;
151 ;;RI01
152 ;;RI02
153 ;;RI03
154 ;;RI04
155 ;;RI05
156 Q
157RE ;
158 ;;RE01
159 Q
160LL ;
161 ;;LL01
162 ;;LL02
163 ;;LL03
164 ;;LL04
165 Q
166EV ;
167 ;;EV01
168 ;;EV02
169 ;;EV03
170 Q
171RG ;
172 ;;RG01
173 ;;RG02
174 ;;RG03
175 Q
176IF ;
177 ;;IF01
178 ;;IF02
179 ;;IF04
180 ;;IF05
181 ;;IF06
182 ;;IF07
183 ;;IF08
184 ;;IF09
185 ;;IF10
186 Q
187CP ;
188 ;;CP01
189 Q
190INSTALL ;check to see if the patch has been installed - if so quit
191 S QACQ=$$PATCH^XPDUTL("QAC*2.0*17")
192 Q
Note: See TracBrowser for help on using the repository browser.