source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY243.m@ 724

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

initial load of WorldVistAEHR
File size: 9.6 KB
Line 
1ORY243 ;SLCOIFO - Pre and Post-init for patch OR*3*243 ; 3/28/08 5:58am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4DELDD ;Delete the old data dictionaries.
5 N DIU,TEXT
6 D EN^DDIOL("Removing old data dictionaries.")
7 S DIU(0)=""
8 S DIU=101.43
9 S TEXT=" Deleting data dictionary for file # "_DIU
10 D EN^DDIOL(TEXT)
11 D EN^DIU2
12 Q
13 ;
14PRE ; initiate pre-init processes
15 D DELDD
16 D PEOMRPT,B
17 D UPDTALRT
18 Q
19 ;
20POST ; initiate post-init processes
21 ;
22 D VITREG ;register Vitals RPC
23 I +$$PATCH^XPDUTL("MAG*3.0*7") D MAGREG1
24 I +$$PATCH^XPDUTL("MAG*3.0*37") D MAGREG2
25 D DLGBULL
26 D MAIL
27 D PARVAL
28 D PARAM
29 D NOTIF
30 D INISET^ORWGAPIU ; graph setting default
31 S ^XTMP("ORGRAPH","FORCE")="ON" ; force rebuild of cache for graphing via ORMTIME
32 D BULLMG
33 D FLAGORD
34 D ^ORY243ES ;expert system changes
35 D DDEDIT
36 D STS
37 D MHDLL
38 D CLRDFTD
39 D INPQCONV^ORY243A
40 D IVORCON^ORY243A
41 D INSTALL^ORWOD ;med quick order report
42 Q
43 ;
44PEOMRPT ;Remove new & changed reports from OE/RR REPORTS file (101.24)
45 N ORI,ORVIT
46 S ORVIT=0
47 I $P($G(^ORD(101.24,3,0)),"^",1)="ORRP AP ALL" D
48 . S ORVIT=1,DA=3,DIK="^ORD(101.24," D ^DIK
49 . S ^ORD(101.24,3,0)="ORRP AP ALL",^ORD(101.24,"B","ORRP AP ALL",3)=""
50 I $P($G(^ORD(101.24,3,0)),"^",1)="ORRP AP MENU" D
51 . S ORVIT=1,DA=3,DIK="^ORD(101.24," D ^DIK
52 . S ^ORD(101.24,3,0)="ORRP AP ALL",^ORD(101.24,"B","ORRP AP ALL",3)=""
53 I $P($G(^ORD(101.24,18,0)),"^",1)="ORL MOST RECENT" D
54 . S ORVIT=1,DA=18,DIK="^ORD(101.24," D ^DIK
55 . S ^ORD(101.24,18,0)="ORL MOST RECENT",^ORD(101.24,"B","ORL MOST RECENT",18)=""
56 I $P($G(^ORD(101.24,19,0)),"^",1)="ORL CUMULATIVE" D
57 . S ORVIT=1,DA=19,DIK="^ORD(101.24," D ^DIK
58 . S ^ORD(101.24,19,0)="ORL CUMULATIVE",^ORD(101.24,"B","ORL CUMULATIVE",19)=""
59 I $P($G(^ORD(101.24,20,0)),"^",1)="ORL ALL TESTS BY DATE" D
60 . S ORVIT=1,DA=20,DIK="^ORD(101.24," D ^DIK
61 . S ^ORD(101.24,20,0)="ORL ALL TESTS BY DATE",^ORD(101.24,"B","ORL ALL TESTS BY DATE",20)=""
62 I $P($G(^ORD(101.24,21,0)),"^",1)="ORL WORKSHEET" D
63 . S ORVIT=1,DA=21,DIK="^ORD(101.24," D ^DIK
64 . S ^ORD(101.24,21,0)="ORL WORKSHEET",^ORD(101.24,"B","ORL WORKSHEET",21)=""
65 I $P($G(^ORD(101.24,22,0)),"^",1)="ORL GRAPH" D
66 . S ORVIT=1,DA=22,DIK="^ORD(101.24," D ^DIK
67 . S ^ORD(101.24,22,0)="ORL GRAPH",^ORD(101.24,"B","ORL GRAPH",22)=""
68 I $P($G(^ORD(101.24,23,0)),"^",1)="ORL MICROBIOLOGY" D
69 . S ORVIT=1,DA=23,DIK="^ORD(101.24," D ^DIK
70 . S ^ORD(101.24,23,0)="ORL MICROBIOLOGY",^ORD(101.24,"B","ORL MICROBIOLOGY",23)=""
71 I $P($G(^ORD(101.24,24,0)),"^",1)="ORL ANATOMIC PATHOLOGY" D
72 . S ORVIT=1,DA=24,DIK="^ORD(101.24," D ^DIK
73 . S ^ORD(101.24,24,0)="ORL ANATOMIC PATHOLOGY",^ORD(101.24,"B","ORL ANATOMIC PATHOLOGY",24)=""
74 I $P($G(^ORD(101.24,25,0)),"^",1)="ORL BLOOD BANK" D
75 . S ORVIT=1,DA=25,DIK="^ORD(101.24," D ^DIK
76 . S ^ORD(101.24,25,0)="ORL BLOOD BANK",^ORD(101.24,"B","ORL BLOOD BANK",25)=""
77 I $P($G(^ORD(101.24,26,0)),"^",1)="ORL LAB STATUS" D
78 . S ORVIT=1,DA=26,DIK="^ORD(101.24," D ^DIK
79 . S ^ORD(101.24,26,0)="ORL LAB STATUS",^ORD(101.24,"B","ORL LAB STATUS",26)=""
80 I $P($G(^ORD(101.24,27,0)),"^",1)="ORL SELECTED TESTS BY DATE" D
81 . S ORVIT=1,DA=27,DIK="^ORD(101.24," D ^DIK
82 . S ^ORD(101.24,27,0)="ORL SELECTED TESTS BY DATE",^ORD(101.24,"B","ORL SELECTED TESTS BY DATE",27)=""
83 I $P($G(^ORD(101.24,1032,0)),"^",1)="ORRPW ALLERGIES ADV" D
84 . S ORVIT=1,DA=1032,DIK="^ORD(101.24," D ^DIK
85 . S ^ORD(101.24,1032,0)="ORRPW ALLERGIES ADV",^ORD(101.24,"B","ORRPW ALLERGIES ADV",1032)=""
86 I $P($G(^ORD(101.24,1100,0)),"^",1)="ORRPW ORDERS CURRENT" D
87 . S ORVIT=1,DA=1100,DIK="^ORD(101.24," D ^DIK
88 . S ^ORD(101.24,1100,0)="ORRPW ORDERS CURRENT",^ORD(101.24,"B","ORRPW ORDERS CURRENT",1100)=""
89 I $P($G(^ORD(101.24,1079,0)),"^",1)="ORRPW PHARMACY ALL OUT" D
90 . S ORVIT=1,DA=1079,DIK="^ORD(101.24," D ^DIK
91 . S ^ORD(101.24,1079,0)="ORRPW PHARMACY ALL OUT",^ORD(101.24,"B","ORRPW PHARMACY ALL OUT",1079)=""
92 I $P($G(^ORD(101.24,48,0)),"^",1)="ORRP SURGERIES" D
93 . S ORVIT=1,DA=48,DIK="^ORD(101.24," D ^DIK
94 . S ^ORD(101.24,48,0)="ORRP SURGERIES",^ORD(101.24,"B","ORRP SURGERIES",48)=""
95 I $P($G(^ORD(101.24,1137,0)),"^",1)="ORRPW DOD ALLERGIES ADV" D
96 . S ORVIT=1,DA=1137,DIK="^ORD(101.24," D ^DIK
97 . S ^ORD(101.24,1137,0)="ORRPW DOD ALLERGIES ADV",^ORD(101.24,"B","ORRPW DOD ALLERGIES ADV",1137)=""
98 I $P($G(^ORD(101.24,1551,0)),"^",1)="ORRPW HDR ALLERGIES" D
99 . S ORVIT=1,DA=1551,DIK="^ORD(101.24," D ^DIK
100 . S ^ORD(101.24,1551,0)="ORRPW HDR ALLERGIES",^ORD(101.24,"B","ORRPW HDR ALLERGIES",1551)=""
101 I $P($G(^ORD(101.24,1553,0)),"^",1)="ORRPW HDR PHARMACY OUT" D
102 . S ORVIT=1,DA=1553,DIK="^ORD(101.24," D ^DIK
103 . S ^ORD(101.24,1553,0)="ORRPW HDR PHARMACY OUT",^ORD(101.24,"B","ORRPW HDR PHARMACY OUT",1553)=""
104 I $P($G(^ORD(101.24,1105,0)),"^",1)="ORRPW DOD PHARM ALL OUT" D
105 . S ORVIT=1,DA=1105,DIK="^ORD(101.24," D ^DIK
106 . S ^ORD(101.24,1105,0)="ORRPW DOD PHARM ALL OUT",^ORD(101.24,"B","ORRPW DOD PHARM ALL OUT",1105)=""
107 I $P($G(^ORD(101.24,1078,0)),"^",1)="ORRPW PHARMACY ACT OUT" D
108 . S ORVIT=1,DA=1078,DIK="^ORD(101.24," D ^DIK
109 . S ^ORD(101.24,1078,0)="ORRPW PHARMACY ACT OUT",^ORD(101.24,"B","ORRPW PHARMACY ACT OUT",1078)=""
110 S ORI=999
111 F S ORI=$O(^ORD(101.24,ORI)) Q:'ORI I ORI<1110!(ORI>1116) S DA=ORI,DIK="^ORD(101.24," D ^DIK
112 Q
113MAIL ; send bulletin of installation time
114 N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
115 S COUNT=0,XMDUZ="CPRS PACKAGE",XMTEXT="TEXT("
116 S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"
117 F I="G.CPRS GUI INSTALL@ISC-SLC.VA.GOV",DUZ S XMY(I)=""
118 ;
119 S X=$P($T(VERSION),";;",2)
120 D LINE("Version "_X_" has been installed.")
121 D LINE(" ")
122 D LINE("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT()))
123 ;
124 D ^XMD
125 Q
126 ;
127CLRDFTD ;
128 N DA,DR,DIE
129 S DA=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS","")) Q:DA'>0
130 I +$P($G(^ORD(100.98,DA,0)),U,4)'>0 Q
131 S DIE="^ORD(100.98,",DR="4///@" D ^DIE
132 Q
133VITREG ; Register Vitals RPC
134 D ADDRPCS^GMV3PST ;call tag from vitals patch post init to register
135 Q
136 ;
137MAGREG1 ; Register Imaging RPC if MAG*3.0*7 installed (DBIA 4526)
138 D INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
139 Q
140 ;
141MAGREG2 ; Register Imaging RPCS if MAG*3.0*37 installed (DBIA 4528/4530)
142 D INSERT("OR CPRS GUI CHART","MAG IMPORT CHECK STATUS")
143 D INSERT("OR CPRS GUI CHART","MAG IMPORT CLEAR STATUS")
144 Q
145 ;
146LINE(DATA) ; set text into array
147 S COUNT=COUNT+1
148 S TEXT(COUNT)=DATA
149 Q
150 ;
151INSERT(OPTION,RPC) ; Call FM Updater with each RPC
152 ; Input -- OPTION Option file (#19) Name field (#.01)
153 ; RPC RPC sub-file (#19.05) RPC field (#.01)
154 ; Output -- None
155 N FDA,FDAIEN,ERR,DIERR
156 S FDA(19,"?1,",.01)=OPTION
157 S FDA(19.05,"?+2,?1,",.01)=RPC
158 D UPDATE^DIE("E","FDA","FDAIEN","ERR")
159 Q
160 ;
161SENDDLG(ANAME) ; Return true if the current order dialog should be sent
162 I ANAME="LR OTHER LAB TESTS" Q 1
163 I ANAME="OR GTX STUDY REASON" Q 1
164 I ANAME="RA OERR EXAM" Q 1
165 I ANAME="PSH OERR" Q 1
166 I ANAME="PSJI OR PAT FLUID OE" Q 1
167 I ANAME="OR GTX IV TYPE" Q 1
168 I ANAME="PSJ OR PAT OE" Q 1
169 I ANAME="PSO OERR" Q 1
170 I ANAME="PSO SUPPLY" Q 1
171 I ANAME="PS MEDS" Q 1
172 I ANAME="OR GTX ADMIN TIMES" Q 1
173 I ANAME="OR GTX SCHEDULE TYPE" Q 1
174 I ANAME="FHW7" Q 1
175 I ANAME="FHW2" Q 1
176 I ANAME="FHW1" Q 1
177 I ANAME="OR GTX UNITS" Q 1
178 Q 0
179 ;
180DLGBULL ; send bulletin about modified dialogs <on first install>
181 N I,ORD
182 F I="PSH OERR","PSJI OR PAT FLUID OE","FHW2","FHW7","RA OERR EXAM","LR OTHER LAB TESTS","PSJ OR PAT OE","PSO OERR","PSO SUPPLY","PS MEDS" S ORD(I)=""
183 D EN^ORYDLG(243,.ORD)
184 Q
185 ;
186VERSION ;;27.77
187 ;
188NOTIF ; DO NOT REMOVE WITH VBECS - rename notif 47 (MEDICATIONS EXPIRING)
189 S $P(^ORD(100.9,47,0),U)="MEDICATIONS EXPIRING - INPT"
190 K ^ORD(100.9,"B")
191 S DIK="^ORD(100.9,",DIK(1)=".01^B" D ENALL^DIK
192 K DIK
193 Q
194 ;
195PARAM ; DO NOT REMOVE WITH VBECS - main (initial) parameter transport routine
196 ; MOVED TO ORY243R - ROUTINE MAXED OUT - 10/02/07 - RV
197 D PARAM^ORY243R
198 Q
199BULLMG ;
200 N MGIEN,FDA,ORERR
201 S MGIEN=$$FIND1^DIC(3.8,,"MX","OR DRUG ORDER CANCELLED")
202 S FDA(3.6,"?1,",.01)="OR DRUG ORDER CANCELLED"
203 S FDA(3.62,"+2,?1,",.01)="OR DRUG ORDER CANCELLED"
204 D UPDATE^DIE("E","FDA","",.ORERR)
205 Q
206FLAGORD ;def reasons flagged ords
207 N CNT,LST
208 D GETLST^XPAR(.LST,"ALL","OR FLAGGED ORD REASONS","I")
209 S CNT=$O(LST(""),-1)
210 Q:CNT>0
211 D EN^XPAR("SYS","OR FLAGGED ORD REASONS",CNT,"Med renewal request")
212 S CNT=CNT+1
213 D EN^XPAR("SYS","OR FLAGGED ORD REASONS",CNT,"Order request")
214 S CNT=CNT+1
215 D EN^XPAR("SYS","OR FLAGGED ORD REASONS",CNT,"Order needing clarification")
216 Q
217MHDLL ;update MH message parameter
218 D EN^XPAR("SYS","OR USE MH DLL",,1)
219 Q
220DDEDIT ;Remove field 80 from file 100
221 ;call to EN^DIU2 where DIU = the subfile number
222 ;DIU(0)="S", The "S" flag indicates subfile DD is to be deleted
223 N DIU S DIU=100.04,DIU(0)="S" D EN^DIU2
224 Q
225STS ;DC status desc
226 K ^ORD(100.01,1,1)
227 S ^ORD(100.01,1,1,0)="^^1^1^3070625^^^^",^(1,0)="Orders that have been explicitly stopped."
228 Q
229 ;
230B ; B xref new-style
231 Q:'$O(^ORD(101.41,"B","OR GTX PRE-OP SCHEDULED DATE/T",0)) ;done
232 N ORI,ORY,ORX S ORI=0
233 F S ORI=$O(^DD(101.41,.01,1,ORI)) Q:ORI<1 S ORY=$G(^(ORI,0)) I ORY="101.41^B" D DELIX^DDMOD(101.41,.01,ORI,"K") Q ;DBIA #1412
234 S ORX("FILE")=101.41,ORX("ROOT FILE")=101.41,ORX("NAME")="B"
235 S ORX("TYPE")="R",ORX("USE")="LS",ORX("EXECUTION")="F",ORX("ACTIVITY")="IR"
236 S ORX("SHORT DESCR")="Regular B index using full field length"
237 S ORX("VAL",1)=.01,ORX("VAL",1,"SUBSCRIPT")=1,ORX("VAL",1,"LENGTH")=63
238 D CREIXN^DDMOD(.ORX,"S",.ORY) ;DBIA #2916
239 Q
240 ;
241UPDTALRT ; AP Alerts
242 N I
243 F I=1:1:3 D
244 . N DIC,DA,X,DIE,DR
245 . S DIC="^ORD(100.9,",DIC(0)="BIXZ"
246 . S X=$S(I=1:"MAMMOGRAM RESULTS",I=2:"PAP SMEAR RESULTS",1:"ANATOMIC PATHOLOGY RESULTS")
247 . D ^DIC I Y=-1 K DIC Q
248 . S DIE=DIC,DR=".06///"_$S(I=1:"RPTRAD2",I=2:"RPTAP",1:"RPTAP")_";5///REPORT",DA=+Y
249 . D ^DIE K DIE,DIC,DR,DA,Y
250 Q
251 ;
252ORWOD ; Med QO Correction
253 D INSTALL^ORWOD ;Run quick order report and send to installers mail box
254 Q
255PARVAL ;Set Param Val
256 D EN^XPAR("PKG","ORWRP REPORT LAB LIST",42,"@")
257 Q
Note: See TracBrowser for help on using the repository browser.