source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY215.m

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1ORY215 ;SLCOIFO - Pre and Post-init for patch OR*3*215 [10/21/04 6:30am] ;1/26/06 15:20
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4 ; DBIA 2336 EN^XPAR ^TMP($J,"XPARRSTR")
5 ;
6PRE ; initiate pre-init processes
7 D PEOMPRE
8 D PEOMRPT
9 Q
10 ;
11POST ; initiate post-init processes
12 ;
13 I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
14 D VITREG ;register Vitals RPC
15 I +$$PATCH^XPDUTL("MAG*3.0*7") D MAGREG1
16 I +$$PATCH^XPDUTL("MAG*3.0*37") D MAGREG2
17 D PEOM ;set-up Outpatient Meals
18 D DLGBULL
19 D IVUPDT
20 D CMUPDT
21 D PARVAL
22 D MAIL
23 D PARAM
24 D NOTIF
25 D INISET^ORWGAPIU ; graph setting default
26 D BULLMG
27 Q
28 ;
29MAIL ; send bulletin of installation time
30 N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY
31 S COUNT=0,XMDUZ="CPRS PACKAGE",XMTEXT="TEXT("
32 S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"
33 F I="G.CPRS GUI INSTALL@ISC-SLC.VA.GOV",DUZ S XMY(I)=""
34 ;
35 S X=$P($T(VERSION),";;",2)
36 D LINE("Version "_X_" has been installed.")
37 D LINE(" ")
38 D LINE("Install complete: "_$$FMTE^XLFDT($$NOW^XLFDT()))
39 ;
40 D ^XMD
41 Q
42 ;
43SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present
44 N MENU,RPC
45 S MENU="OR CPRS GUI CHART"
46 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)
47 Q
48VITREG ; Register Vitals RPC
49 D ADDRPCS^GMV3PST ;call tag from vitals patch post init to register
50 Q
51 ;
52MAGREG1 ; Register Imaging RPC if MAG*3.0*7 installed (DBIA 4526)
53 D INSERT("OR CPRS GUI CHART","MAG4 REMOTE IMPORT")
54 Q
55 ;
56MAGREG2 ; Register Imaging RPCS if MAG*3.0*37 installed (DBIA 4528/4530)
57 D INSERT("OR CPRS GUI CHART","MAG IMPORT CHECK STATUS")
58 D INSERT("OR CPRS GUI CHART","MAG IMPORT CLEAR STATUS")
59 Q
60 ;
61LINE(DATA) ; set text into array
62 S COUNT=COUNT+1
63 S TEXT(COUNT)=DATA
64 Q
65 ;
66INSERT(OPTION,RPC) ; Call FM Updater with each RPC
67 ; Input -- OPTION Option file (#19) Name field (#.01)
68 ; RPC RPC sub-file (#19.05) RPC field (#.01)
69 ; Output -- None
70 N FDA,FDAIEN,ERR,DIERR
71 S FDA(19,"?1,",.01)=OPTION
72 S FDA(19.05,"?+2,?1,",.01)=RPC
73 D UPDATE^DIE("E","FDA","FDAIEN","ERR")
74 Q
75 ;
76PEOMPRE ;Remove Print fields and Print format entries before installing new
77 N Y,DIK,ORK,DA
78 S DIK="^ORD(100.22,"
79 F ORK=2002,2003,2004,2005,2006 S DA=ORK D ^DIK
80 S DIK="^ORD(100.23,"
81 F ORK=1036,1037,1038 S DA=ORK D ^DIK
82 Q
83PEOMRPT ;Remove new & changed reports from OE/RR REPORTS file (101.24)
84 N ORVIT,ORI
85 S ORVIT=0
86 I $P($G(^ORD(101.24,34,0)),"^",1)="ORCV VITALS" D
87 . S ORVIT=1,DA=34,DIK="^ORD(101.24," D ^DIK
88 . S ^ORD(101.24,34,0)="ORCV VITALS",^ORD(101.24,"B","ORCV VITALS",34)=""
89 N APPTRPT
90 S APPTRPT=$G(^ORD(101.24,35,0))
91 I $P(APPTRPT,U)="ORCV APPOINTMENTS",$P(APPTRPT,U,5)="ORWCV",$P(APPTRPT,U,6)="VST" D
92 . S $P(^ORD(101.24,35,0),U,6)="VST1"
93 I 'ORVIT S ORVIT=$O(^ORD(101.24,"B","ORCV VITALS",0)) D
94 . Q:'ORVIT
95 . S DA=ORVIT,DIK="^ORD(101.24," D ^DIK
96 . S ^ORD(101.24,ORVIT,0)="ORCV VITALS",^ORD(101.24,"B","ORCV VITALS",ORVIT)=""
97 N ORI
98 S ORI=999
99 F S ORI=$O(^ORD(101.24,ORI)) Q:'ORI I ORI<1110!(ORI>1116) S DA=ORI,DIK="^ORD(101.24," D ^DIK
100 Q ;Don't step on Rich's patch 151
101PEOM ; -- setup Outpatient Meals
102 N DA,DIC,DIE,DR,DLAYGO,X,Y,DO,DD,ID,ORDG
103 S ORDG=$O(^ORD(100.98,"B","DIET",0)) Q:'ORDG
104 ; create new Orderable Item
105 S X="NO MEAL",Y=+$O(^ORD(101.43,"S.DIET",X,0)) Q:Y>0 ;not 1st install
106 S DIC="^ORD(101.43,",DIC(0)="LX",DLAYGO=101.43,DIE=DIC
107 K DO,DD D FILE^DICN Q:Y'>0 ; error
108 S DA=+Y,ID=DA_";99ORD",DR="1.1///NO MEAL;2///^S X=ID;5////"_ORDG D ^DIE
109 K DA,DIC,DIE,DR,DLAYGO,X,Y,DO,DD
110 ; link new Display Group to DIETETICS
111 S X=$O(^ORD(100.98,"B","MEAL",0)),DA(1)=ORDG Q:'X
112 I $O(^ORD(100.98,DA(1),1,"B",X,0)) Q ;not first install - done.
113 S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
114 S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="NLX",DLAYGO=100.98
115 S X="OUTPATIENT MEALS" D ^DIC
116 D SETFHPRT
117 Q
118DLGBULL ; send bulletin about modified dialogs <on first install>
119 N I,ORD
120 F I="FHW2","FHW7","FHW8","RA OERR EXAM","LR OTHER LAB TESTS" S ORD(I)=""
121 D EN^ORYDLG(215,.ORD)
122 Q
123 ;
124CMUPDT ;
125 N AIEN,CIEN,DIE,DR,DA,FDA,NAME
126 S DA=$O(^ORD(100.98,"B","CLINIC MEDICATIONS","")) I +$G(DA)>0 D
127 .S CIEN=DA
128 .S DIE="^ORD(100.98,",DR=".01///CLINIC ORDERS",DR=DR_";2///Clinic Orders"
129 .D ^DIE
130 I $G(CIEN)'>0 S CIEN=$O(^ORD(100.98,"B","CLINIC ORDERS",""))
131 S AIEN=$O(^ORD(100.98,"B","ALL SERVICES",""))
132 I $D(^ORD(100.98,AIEN,1,"B",CIEN))>0 Q
133 S FDA(100.981,"+2,"_AIEN_",",.01)=CIEN
134 D UPDATE^DIE("","FDA","","MSG")
135 Q
136PARVAL ; Set parameter values
137 ; Set VistaWeb Parameter
138 D EN^XPAR("PKG","ORWRP VISTAWEB ADDRESS",1,"https://vhaiswwebv7.vha.med.va.gov/vistaweb/ToolsPage.aspx")
139 D EN^XPAR("PKG","ORWRP REPORT LIST",6,"ORRPW HDR")
140 Q
141IVUPDT ;
142 N IVDG S IVDG=0
143 S IVDG=$O(^ORD(100.98,"B","IV MEDICATIONS",0))
144 S:IVDG $P(^ORD(100.98,IVDG,0),U,2)="Infusion"
145 N IVMN,IVODSP S IVMN=0,IVODSP=""
146 S IVMN=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE MENU",0))
147 I IVMN D
148 . S IVODSP=$P(^ORD(101.41,IVMN,0),U,2)
149 . S $P(^ORD(101.41,IVMN,0),U,2)="IV FLUIDS AND INFUSION ORDER"
150 . S ^ORD(101.41,"C","IV FLUIDS AND INFUSION ORDER",IVMN)=""
151 . K ^ORD(101.41,"C",IVODSP,IVMN)
152 Q
153 ;
154SENDDLG(ANAME) ; Return true if the current order dialog should be sent
155 ; New dialogs for Outpatient Meals:
156 I ANAME="FHW OP MEAL" Q 1
157 I ANAME="FHW SPECIAL MEAL" Q 1
158 I ANAME="FHW2" Q 1
159 I ANAME="FHW7" Q 1
160 I ANAME="FHW8" Q 1
161 I ANAME="OR GTX VISITSTR" Q 1
162 I ANAME="OR GTX DELIVERY" Q 1
163 I ANAME="OR GTX DATE/TIME" Q 1
164 I ANAME="OR GTX MEAL DATE" Q 1
165 I ANAME="OR GTX ADDL DIETS" Q 1
166 I ANAME="PSH OERR" Q 1
167 ; Update IV Dialog
168 I ANAME="PSJI OR PAT FLUID OE" Q 1
169 I ANAME="RA OERR EXAM" Q 1
170 I ANAME="LR OTHER LAB TESTS" Q 1
171 Q 0
172 ;
173SETFHPRT ; Set Outpt Meals print formats
174 N VAL,PKG
175 S PKG="DIETETICS"
176 S VAL=$O(^ORD(100.23,"B","FH OUTPT MEAL TICKET",0))
177 D EN^XPAR("SYS","ORPF WARD REQUISITION FORMAT",PKG,VAL)
178 S VAL=$O(^ORD(100.23,"B","FH OUTPT MEAL HEADER",0))
179 D EN^XPAR("SYS","ORPF WARD REQUISITION HEADER",PKG,VAL)
180 S VAL=$O(^ORD(100.23,"B","FH OUTPT MEAL FOOTER",0))
181 D EN^XPAR("SYS","ORPF WARD REQUISITION FOOTER",PKG,VAL)
182 Q
183 ;
184VERSION ;;26.66
185 ;
186NOTIF ; DO NOT REMOVE WITH VBECS - rename notif 47 (MEDICATIONS EXPIRING)
187 S $P(^ORD(100.9,47,0),U)="MEDICATIONS EXPIRING - INPT"
188 K ^ORD(100.9,"B")
189 S DIK="^ORD(100.9,",DIK(1)=".01^B" D ENALL^DIK
190 K DIK
191 Q
192 ;
193PARAM ; DO NOT REMOVE WITH VBECS - main (initial) parameter transport routine
194 K ^TMP($J,"XPARRSTR")
195 N ENT,IDX,ROOT,REF,VAL,I
196 S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_"," ;DBIA 2336
197 D LOAD
198XX2 S IDX=0,ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"
199 F S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX D
200 . N PAR,INST,ORVAL,ORERR K ORVAL
201 . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
202 . M ORVAL=^TMP($J,"XPARRSTR",IDX,"VAL")
203 . D EN^XPAR(ENT,PAR,INST,.ORVAL,.ORERR) ;DBIA 2336
204 K ^TMP($J,"XPARRSTR")
205 Q
206LOAD ; load data into ^TMP (expects ROOT to be defined)
207 S I=1 F S REF=$T(DATA+I) Q:REF="" S VAL=$T(DATA+I+1) D
208 . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
209 . S @(ROOT_REF)=VAL
210 Q
211BULLMG ;
212 N MGIEN,FDA,ORERR
213 S MGIEN=$$FIND1^DIC(3.8,,"MX","OR DRUG ORDER CANCELLED")
214 S FDA(3.6,"?1,",.01)="OR DRUG ORDER CANCELLED"
215 S FDA(3.62,"+2,?1,",.01)="OR DRUG ORDER CANCELLED"
216 D UPDATE^DIE("E","FDA","",.ORERR)
217 Q
218DATA ; parameter data
219 ;;7240,"KEY")
220 ;;ORB ARCHIVE PERIOD^MEDICATIONS EXPIRING - OUTPT
221 ;;7240,"VAL")
222 ;;30
223 ;;7241,"KEY")
224 ;;ORB DELETE MECHANISM^MEDICATIONS EXPIRING - OUTPT
225 ;;7241,"VAL")
226 ;;All Recipients
227 ;;7242,"KEY")
228 ;;ORB FORWARD BACKUP REVIEWER^MEDICATIONS EXPIRING - OUTPT
229 ;;7242,"VAL")
230 ;;0
231 ;;7243,"KEY")
232 ;;ORB FORWARD SUPERVISOR^MEDICATIONS EXPIRING - OUTPT
233 ;;7243,"VAL")
234 ;;0
235 ;;7244,"KEY")
236 ;;ORB FORWARD SURROGATES^MEDICATIONS EXPIRING - OUTPT
237 ;;7244,"VAL")
238 ;;0
239 ;;7245,"KEY")
240 ;;ORB PROCESSING FLAG^MEDICATIONS EXPIRING - OUTPT
241 ;;7245,"VAL")
242 ;;Disabled
243 ;;7246,"KEY")
244 ;;ORB PROVIDER RECIPIENTS^MEDICATIONS EXPIRING - OUTPT
245 ;;7246,"VAL")
246 ;;OAPT
247 ;;7247,"KEY")
248 ;;ORB URGENCY^MEDICATIONS EXPIRING - OUTPT
249 ;;7247,"VAL")
250 ;;High
251 ;;6064,"KEY")
252 ;;ORWOR EXPIRED ORDERS^1
253 ;;6064,"VAL")
254 ;;72
Note: See TracBrowser for help on using the repository browser.