source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKUTL.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1ORKUTL ; slc/CLA - Utility routine for order checking ;5/21/97 16:25
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6**;Dec 17, 1997
3ONOFF(ORK,ORKUSR,ORKPT) ;Extrinsic function to check param file determines if
4 ; user ORKUSR should receive order check ORK for patient ORKPT.
5 ;ORK order check ien from file 864.5 (req'd)
6 ;ORKUSR user ien from file 200 (req'd)
7 ;ORKPT patient ien from file 2 (not req'd)
8 ;
9 N NODE,ORKNAME,ORKUSRN,ORKUSRF,ORKPTN,ORKLOC,ORKLOCN,ORKLOCF
10 N ORKSRV,ORKSRVN,ORKSRVF,ORKDIVF,ORKSYSF,ORKPKGF
11 ;
12 ;get order check name:
13 S NODE=$G(^ORD(100.8,ORK,0)) S:$L($G(NODE)) ORKNAME=$P(NODE,U)
14 ;
15 ;get user name:
16 S NODE=$G(^VA(200,ORKUSR,0)) S:$L($G(NODE)) ORKUSRN=$P(NODE,U)
17 ;
18 ;get patient name:
19 S:$L($G(ORKPT)) NODE=$G(^DPT(ORKPT,0)) S:$L($G(NODE)) ORKPTN=$P(NODE,U)
20 ;
21 ;get patient's location (INPATIENT ONLY - outpt locations cannot be
22 ;reliably determined, and many simultaneous outpt locations can occur):
23 I +$G(ORKPT)>0 D
24 .N DFN S DFN=ORKPT,VA200="" D OERR^VADPT
25 .S ORKLOC=+$G(^DIC(42,+VAIN(4),44)) I +$G(ORKLOC)>0 D
26 ..S ORKLOCN=$P(^SC(+ORKLOC,0),U)
27 K VA200,VAIN
28 ;
29 ;get user's service/section:
30 S ORKSRV=$G(^VA(200,ORKUSR,5)) I +ORKSRV>0 S ORKSRV=$P(ORKSRV,U) D
31 .S NODE=$G(^DIC(49,ORKSRV,0)) S:$L($G(NODE)) ORKSRVN=$P(NODE,U)
32 ;
33 S ORK="`"_ORK
34 ;
35 ;get user's flag:
36 S ORKUSRF=$$GET^XPAR("USR.`"_+$G(ORKUSR),"ORK PROCESSING FLAG",ORK,"B")
37 Q:$L($G(ORKUSRF)) $S($P(ORKUSRF,U)="D":"OFF",1:"ON")_"^User value is "_$P(ORKUSRF,U,2)
38 ;
39 ;get patient location flag:
40 I +$G(ORKLOC)>0 D
41 .S ORKLOCF=$$GET^XPAR("LOC.`"_+$G(ORKLOC),"ORK PROCESSING FLAG",ORK,"B")
42 Q:$L($G(ORKLOCF)) $S($P(ORKLOCF,U)="D":"OFF",1:"ON")_"^Pt's location "_ORKLOCN_" value is "_$P(ORKLOCF,U,2)
43 ;
44 ;get user's service flag:
45 I +$G(ORKSRV)>0 D
46 .S ORKSRVF=$$GET^XPAR("SRV.`"_+$G(ORKSRV),"ORK PROCESSING FLAG",ORK,"B")
47 Q:$L($G(ORKSRVF)) $S($P(ORKSRVF,U)="D":"OFF",1:"ON")_"^User's service "_ORKSRVN_" value is "_$P(ORKSRVF,U,2)
48 ;
49 ;get user's division flag:
50 S ORKDIVF=$$GET^XPAR("DIV","ORK PROCESSING FLAG",ORK,"B")
51 Q:$L($G(ORKDIVF)) $S($P(ORKDIVF,U)="D":"OFF",1:"ON")_"^Division value is "_$P(ORKDIVF,U,2)
52 ;
53 ;get system flag:
54 S ORKSYSF=$$GET^XPAR("SYS","ORK PROCESSING FLAG",ORK,"B")
55 Q:$L($G(ORKSYSF)) $S($P(ORKSYSF,U)="D":"OFF",1:"ON")_"^System value is "_$P(ORKSYSF,U,2)
56 ;
57 ;get OE/RR package-exported flag:
58 S ORKPKGF=$$GET^XPAR("PKG","ORK PROCESSING FLAG",ORK,"B")
59 Q:$L($G(ORKPKGF)) $S($P(ORKPKGF,U)="D":"OFF",1:"ON")_"^OERR value is "_$P(ORKPKGF,U,2)
60 ;
61 Q "ON^No value found"
62USRCHKS(ORKUSR) ; generate a list of order checks indicating user's recip status
63 I +$G(ORKUSR)<1 S ORKUSR=DUZ
64 N ORY,ORYI,ORKY,ORKIEN,ORKNAM,NODE,ORX,DESC,HDR
65 S ORYI=1
66 ;
67 ;prompt for additional information:
68 W !!,"Would you like help understanding the list of order checks" S %=2 D YN^DICN I %=1 D HLPMSG
69 K %
70 ;
71 ;see if order checking system is disabled:
72 S ORX=$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")
73 I ORX="D" D
74 .S ORY(ORYI)="Order Checking is disabled. No order checks will be processed or displayed."
75 .S NODE=$G(^VA(200,ORKUSR,0)) S:$L($G(NODE)) HDR="Order Check List for "_$P(NODE,U)
76 .S DESC="Order check possibilities for a user"
77 .D OUTPUT(.ORY,DESC,HDR)
78 Q:ORX="D"
79 ;
80 W !!,"This will take a moment or two, please stand by."
81 ;
82 S ORY(ORYI)="Order Check ON/OFF For This User and Why",ORYI=ORYI+1
83 S ORY(ORYI)="-------------------------------- ---------------------------------------------",ORYI=ORYI+1
84 ;
85 ;loop thru all order checks and determine recipient status:
86 S ORKNAM="" F S ORKNAM=$O(^ORD(100.8,"B",ORKNAM)) Q:ORKNAM="" D
87 .S ORKIEN=0,ORKIEN=$O(^ORD(100.8,"B",ORKNAM,ORKIEN)) I +$G(ORKIEN)>0 D
88 ..S ORKY(ORKNAM)=ORKIEN
89 ..S ORX=$$ONOFF(ORKIEN,ORKUSR,"") I $L($G(ORX)) D
90 ...W "."
91 ...S ORKNAM=$E(ORKNAM_" ",1,32)
92 ...S ORY(ORYI)=ORKNAM_" "_$E($P(ORX,U)_" ",1,5)_$P(ORX,U,2),ORYI=ORYI+1
93 ;
94 S ORYI=ORYI+1,ORY(ORYI)="",ORYI=ORYI+1,ORY(ORYI)="",ORYI=ORYI+1
95 S DESC="Order check possibilities for a user"
96 S NODE=$G(^VA(200,ORKUSR,0)) S:$L($G(NODE)) HDR="Order Check List for "_$P(NODE,U)
97 D OUTPUT(.ORY,DESC,HDR)
98 Q
99HLPMSG ;display/print help message for a user's order checks
100 N ORY,ORYI
101 S ORYI=1
102 S ORY(ORYI)="The delivery of order checks is determined from values set for Users,",ORYI=ORYI+1
103 S ORY(ORYI)="Inpatient Locations, Service/Sections, Hospital Divisions, Computer System and",ORYI=ORYI+1
104 S ORY(ORYI)="OERR. Possible values include 'Enabled' and 'Disabled'. These values indicate",ORYI=ORYI+1
105 S ORY(ORYI)="a User's, Location's, Service/Section's, Division's, System's and OERR's",ORYI=ORYI+1
106 S ORY(ORYI)="desire for the order check to be 'Enabled' (displayed under most",ORYI=ORYI+1
107 S ORY(ORYI)="circumstances) or 'Disabled' (normally not displayed.)",ORYI=ORYI+1
108 S ORY(ORYI)="",ORYI=ORYI+1
109 S ORY(ORYI)="All values, except the OERR (Order Entry) value, can be set by IRM",ORYI=ORYI+1
110 S ORY(ORYI)="or Clinical Coordinators. Individual users can set their 'Enabled/Disabled'",ORYI=ORYI+1
111 S ORY(ORYI)="values for each specific order check via the 'Enable/Disable My Order Checks'",ORYI=ORYI+1
112 S ORY(ORYI)="option under the Personal Preferences and Order Check Management for Users.",ORYI=ORYI+1
113 S ORY(ORYI)="'ON' indicates the user will receive the order check under normal conditions.",ORYI=ORYI+1
114 S ORY(ORYI)="'OFF' indicates the user normally will not receive the order check.",ORYI=ORYI+1
115 S ORY(ORYI)="Order check recipient determination can also be influenced by patient",ORYI=ORYI+1
116 S ORY(ORYI)="location (inpatients only.) This list does not consider patient location",ORYI=ORYI+1
117 S ORY(ORYI)="when calculating the ON/OFF value for an order check because a patient is",ORYI=ORYI+1
118 S ORY(ORYI)="not known when the option is selected.",ORYI=ORYI+1
119 S ORY(ORYI)="",ORYI=ORYI+1,ORY(ORYI)="",ORYI=ORYI+1
120 S DESC="Help Message - order check possibilities for a user"
121 S HDR="Order Check List Help Message"
122 D OUTPUT(.ORY,DESC,HDR)
123 Q
124OUTPUT(ORY,ORKDESC,ORKHDR) ;prompt for device and send report
125 N POP,ORBHDR
126 N ZTRTN,ZTSAVE,ZTDESC
127 ;prompt for device:
128 S %ZIS="Q" ;prompt for Queueing
129 D ^%ZIS
130 Q:$G(POP)>0
131 I $D(IO("Q")) D ;queue the report
132 .S ZTRTN="PRINT^ORB3U1"
133 .S ORBHDR=ORKHDR
134 .S ZTSAVE("ORY(")="",ZTSAVE("ORBHDR")=""
135 .S ZTDESC=ORKDESC
136 .D ^%ZTLOAD
137 .I $D(ZTSK)[0 W !!?5,"Report canceled!"
138 .E W !!?5,"Report queued."
139 .D HOME^%ZIS
140 K %ZIS
141 I $D(IO("Q")) K IO("Q") Q
142PRINT ;print body of List User's Order checks Report
143 N END,PAGE,I,X
144 S (END,PAGE,I)=0
145 U IO
146 D @("HDR"_(2-($E(IOST,1,2)="C-")))
147 F S I=$O(ORY(I)) Q:I=""!(END=1) D
148 .D HDR:$Y+5>IOSL
149 .Q:END=1
150 .W !,ORY(I)
151 I END=1 W !!," - Report Interrupted -",!
152 E W " - End of Report -",!
153 I ($E(IOST,1,2)="C-") W !,"Press RETURN to continue: " R X:DTIME
154 D ^%ZISC
155 D:$G(ZTSK) KILL^%ZTLOAD
156 Q
157HDR ;print header of report
158 I PAGE,($E(IOST,1,2)="C-") D
159 .W !,"Press RETURN to continue or '^' to exit: "
160 .R X:DTIME S END='$T!(X="^")
161 Q:END=1
162HDR1 W:'($E(IOST,1,2)='"C-"&'PAGE) @IOF
163HDR2 S PAGE=PAGE+1 W ?20,ORKHDR
164 W ?(IOM-10),"Page: ",$J(PAGE,3),!!
165 Q
Note: See TracBrowser for help on using the repository browser.