source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY195.m

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

initial load of FOIAVistA 6/30/08 version

File size: 7.6 KB
Line 
1ORY195 ;SLCOIFO - Pre and Post-init for patch OR*3*195 [10/4/04 7:21am] ; [1/20/05 9:26am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
3 ;
4PRE ; initiate pre-init processes
5 ;
6 ; Dump previously-installed param templates w/bad "B" x-ref entries:
7 ;
8 N DA,DIK
9 ;
10 S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (DIVISION)",0))
11 I +DA>0 S DIK="^XTV(8989.52," D ^DIK
12 ;
13 S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SERVICE)",0))
14 I +DA>0 S DIK="^XTV(8989.52," D ^DIK
15 ;
16 S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (SYSTEM)",0))
17 I +DA>0 S DIK="^XTV(8989.52," D ^DIK
18 ;
19 S DA=$O(^XTV(8989.52,"B","ORQQ SEARCH RANGE (USER)",0))
20 I +DA>0 S DIK="^XTV(8989.52," D ^DIK
21 ;
22 Q
23 ;
24POST ; initiate post-init processes
25 ;
26 I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
27 I +$$PATCH^XPDUTL("OR*3.0*222") D GNRPCS
28 I +$$PATCH^XPDUTL("MAG*3.0*7") D MAGRPC1
29 I +$$PATCH^XPDUTL("MAG*3.0*37") D MAGRPC2
30 D SETIMO
31 D PARVAL
32 D STUFDTRG
33 D MAIL
34 D Q^ORY195A ;Queue lab order check routine
35 Q
36 ;
37MAIL ; send bulletin of installation time
38 N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
39 S COUNT=0,XMDUZ="CPRS PACKAGE",XMTEXT="TEXT("
40 S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"
41 F I="G.CPRS GUI INSTALL@ISC-SLC.VA.GOV",DUZ S XMY(I)=""
42 ;
43 S X=$P($T(VERSION),";;",2)
44 D LINE("Version "_X_" has been installed.")
45 D LINE(" ")
46 D LINE("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT()))
47 ;
48 D ^XMD
49 Q
50 ;
51LINE(DATA) ; set text into array
52 S COUNT=COUNT+1
53 S TEXT(COUNT)=DATA
54 Q
55 ;
56SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present
57 N MENU,RPC
58 S MENU="OR CPRS GUI CHART"
59 F RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES","TIU GET DOCUMENTS FOR REQUEST" D INSERT(MENU,RPC)
60 Q
61 ;
62INSERT(OPTION,RPC) ; Call FM Updater with each RPC
63 ; Input -- OPTION Option file (#19) Name field (#.01)
64 ; RPC RPC sub-file (#19.05) RPC field (#.01)
65 ; Output -- None
66 N FDA,FDAIEN,ERR,DIERR
67 S FDA(19,"?1,",.01)=OPTION
68 S FDA(19.05,"?+2,?1,",.01)=RPC
69 D UPDATE^DIE("E","FDA","FDAIEN","ERR")
70 Q
71 ;
72SETIMO ; Create "CLINIC MEDICATIONS" display group
73 N NDATA,DLG,IEN,X
74 S (NDATA,DLG,IEN,X)=""
75 S NDATA="CLINIC MEDICATIONS^Clin. Meds^C RX^"
76 N DIC
77 S DIC="^ORD(100.98,",DIC(0)="BX",X=$P(NDATA,U)
78 D ^DIC
79 I Y'=-1 S ^ORD(100.98,+Y,0)=NDATA Q
80 I Y=-1 S DIC(0)="L" D ^DIC
81 S DIC(0)="BX" D ^DIC
82 S IEN=+Y
83 I 'IEN Q
84 N DIE,DA,DR
85 S DIE="^ORD(100.98,",DA=IEN,DR="2///Clin. Meds;3///C RX"
86 D ^DIE
87 N DLAYGO
88 S DA(1)=$O(^ORD(100.98,"B","PHARMACY",0)) Q:'DA(1)
89 S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
90 S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="NLX",DLAYGO=100.98
91 S X="CLINIC MEDICATIONS" D ^DIC
92 K Y
93 Q
94PARVAL ;add Clin. Meds display group to SEQUENCE parameter
95 N X
96 Q:'$D(^ORD(100.98,"B","CLINIC MEDICATIONS"))
97 S X=0,X=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",X)) Q:'X D
98 . D PUT^XPAR("PKG","ORWOR CATEGORY SEQUENCE",69,X)
99 Q
100 ;
101SCH ; -- Adjust admin schedule Help Msg for Non-Std Schedules
102 N SCH,I,DG,PKG,IPKG,DLG,PRMT,OR0
103 S SCH=+$O(^ORD(101.41,"B","OR GTX SCHEDULE",0)) Q:SCH<1
104 F I="I","UD","O","C" S X=+$O(^ORD(100.98,"B",I_" RX",0)) S:X DG(X)=""
105 F I="RX","SPLY" S X=+$O(^ORD(100.98,"B",I,0)) S:X DG(X)=""
106 F PKG="PSJ","PSO","PSS" D
107 . S IPKG=+$O(^DIC(9.4,"C",PKG,0))
108 . S DLG=0 F S DLG=+$O(^ORD(101.41,"APKG",IPKG,DLG)) Q:DLG<1 D
109 .. S OR0=$G(^ORD(101.41,DLG,0)) Q:$P(OR0,U,4)'="D" Q:'$D(DG($P(OR0,U,5)))
110 .. S PRMT=+$O(^ORD(101.41,DLG,10,"D",SCH,0)) Q:PRMT<1
111 .. S ^ORD(101.41,DLG,10,PRMT,1)="Enter a standard administration schedule."
112 Q
113 ;
114STUFDTRG ; Stuff existing date ranges into new parameters for CS and PCE.
115 ;
116 ; Get existing settings, stuff into new parameters.
117 ;
118 ; NOTE: ORQQCSDR params will allow "T, T+, T- settings.
119 ; ORQQEAPT params allow single value number entries only.
120 ;
121 N ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORSTART,ORSTOP,ORVAL
122 ;
123 ; First deal with PKG level settings.
124 ;
125 ; Clean out any existing settings:
126 D NDEL^XPAR("PKG","ORQQEAPT ENC APPT START",.ORERR)
127 D NDEL^XPAR("PKG","ORQQEAPT ENC APPT STOP",.ORERR)
128 D NDEL^XPAR("PKG","ORQQCSDR CS RANGE START",.ORERR)
129 D NDEL^XPAR("PKG","ORQQCSDR CS RANGE STOP",.ORERR)
130 ;
131 ; Get settings of previously-used high level params:
132 S ORSTART=$$GET^XPAR("DIV^SYS^PKG","ORQQVS SEARCH RANGE START",1,"I")
133 I '$L(ORSTART) S ORSTART=90
134 S ORSTOP=$$GET^XPAR("DIV^SYS^PKG","ORQQAP SEARCH RANGE STOP",1,"I")
135 I '$L(ORSTOP) S ORSTOP=90
136 ;
137 ; Stuff retrieved values into PKG level of first set of new params:
138 D EN^XPAR("PKG","ORQQCSDR CS RANGE START",1,ORSTART)
139 D EN^XPAR("PKG","ORQQCSDR CS RANGE STOP",1,ORSTOP)
140 ;
141 ; Treat "start" value and stuff it:
142 S ORVAL=ORSTART,ORNEG=0
143 I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
144 I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
145 I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
146 I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
147 S ORVAL=+ORVAL
148 I 'ORNEG S ORVAL=0 ; Can't have later than "Today" for "start."
149 D EN^XPAR("PKG","ORQQEAPT ENC APPT START",1,ORVAL)
150 ;
151 ; Treat "stop" value and stuff it:
152 S ORVAL=ORSTOP,ORNEG=0
153 I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
154 I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
155 I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
156 I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
157 S ORVAL=+ORVAL
158 I ORNEG S ORVAL=0 ; Won't allow earlier than "Today" for "stop."
159 D EN^XPAR("PKG","ORQQEAPT ENC APPT STOP",1,ORSTOP)
160 ;
161 ; Deal with User level settings.
162 ;
163 S (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
164 ;
165 ; Begin with the START parameter:
166 D ENVAL^XPAR(.ORLST,"ORQQAP SEARCH RANGE START",1,.ORERR)
167 I 'ORERR,$G(ORLST)>0 D
168 .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) D
169 ..S ORBZ=$P(ORBE,";",2)
170 ..I ORBZ="VA(200," S ORDUZ=$P(ORBE,";") I $L($G(ORDUZ)) D
171 ...S ORVAL=ORLST(ORBE,1) ; Current setting.
172 ...;
173 ...; Eliminate any existing entries:
174 ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",.ORERR)
175 ...;
176 ...; Stuff value:
177 ...D EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE START",1,ORVAL)
178 ...;
179 ...; Treat value:
180 ...S ORNEG=0
181 ...I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
182 ...I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
183 ...I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
184 ...I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
185 ...S ORVAL=+ORVAL
186 ...I 'ORNEG S ORVAL=0 ; Can't have later than "Today" for "start."
187 ...;
188 ...; Eliminate any existing entries:
189 ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",.ORERR)
190 ...;
191 ...; Stuff value:
192 ...D EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT START",1,ORVAL)
193 ;
194 ; Now do the STOP parameter:
195 S (ORBE,ORBX,ORBZ,ORDUZ,ORERR,ORLST,ORNEG,ORVAL)=""
196 ;
197 D ENVAL^XPAR(.ORLST,"ORQQVS SEARCH RANGE STOP",1,.ORERR)
198 I 'ORERR,$G(ORLST)>0 D
199 .F ORBX=1:1:ORLST S ORBE=$O(ORLST(ORBE)) D
200 ..S ORBZ=$P(ORBE,";",2)
201 ..I ORBZ="VA(200," S ORDUZ=$P(ORBE,";") I $L($G(ORDUZ)) D
202 ...S ORVAL=ORLST(ORBE,1) ; Current setting.
203 ...;
204 ...; Eliminate any existing entries:
205 ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",.ORERR)
206 ...;
207 ...; Stuff value:
208 ...D EN^XPAR("USR.`"_ORDUZ,"ORQQCSDR CS RANGE STOP",1,ORVAL)
209 ...;
210 ...; Treat parameter value:
211 ...S ORNEG=0
212 ...I ORVAL["T" S ORVAL=$P(ORVAL,"T",2)
213 ...I ORVAL["t" S ORVAL=$P(ORVAL,"t",2)
214 ...I ORVAL["-" S ORNEG=1,ORVAL=$P(ORVAL,"-",2)
215 ...I ORVAL["+" S ORVAL=$P(ORVAL,"+",2)
216 ...S ORVAL=+ORVAL
217 ...I ORNEG S ORVAL=0 ; Can't have earlier than "Today" for "stop."
218 ...;
219 ...; Eliminate any existing entries:
220 ...D NDEL^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",.ORERR)
221 ...;
222 ...; Stuff value:
223 ...D EN^XPAR("USR.`"_ORDUZ,"ORQQEAPT ENC APPT STOP",1,ORVAL)
224 ;
225 Q
226 ;
227GNRPCS ;
228 N MENU,I
229 S MENU="OR CPRS GUI CHART"
230 F I="ORWGN GNLOC","ORWGN AUTHUSR" D INSERT(MENU,I)
231 Q
232 ;
233MAGRPC1 ; Register Imaging RPC if MAG*3.0*7 present (DBIA 4526)
234 D INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
235 Q
236 ;
237MAGRPC2 ; Register Imaging RPCS if MAG*3.0*37 installed (DBIA 4528/4530)
238 D INSERT("OR CPRS GUI CHART","MAG IMPORT CHECK STATUS")
239 D INSERT("OR CPRS GUI CHART","MAG IMPORT CLEAR STATUS")
240 Q
241 ;
242VERSION ;;25.28
Note: See TracBrowser for help on using the repository browser.