source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPR07.m@ 949

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

initial load of WorldVistAEHR
File size: 7.3 KB
Line 
1ORPR07 ; slc/dcm - Printless in Tuscaloosa ;6/10/97 15:36
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**15,11,94,141**;Dec 17, 1997
3ORDT(IFN,ACT) ;Get order date
4 ;IFN=ORIFN
5 ;ACT=DA of action
6 Q:'$G(IFN) ""
7 Q:'$D(^OR(100,IFN,0)) ""
8 N X,Y
9 S X="" I $G(ACT) S Y=$$ACT(IFN,ACT) Q +Y
10 S X=$P(^OR(100,IFN,0),"^",7)
11 Q X
12ACT(IFN,ACT) ;This is an action
13 N X
14 Q:'$D(^OR(100,+$G(IFN),8,+$G(ACT),0)) "" S X=^(0)
15 Q X
16VNURSE(IFN,ACT) ;Get verifying nurse data
17 ;Returns 1^name^initials^title^date/time verified if data, "" if not
18 Q:'$G(IFN) ""
19 Q:'$D(^OR(100,IFN,0)) ""
20 N X,Y,Z S X=""
21 I $G(ACT) S Y=$$ACT(IFN,ACT),Z=$G(^VA(200,+$P(Y,"^",8),0)) I $L(Z) S X=1_"^"_$P(Z,"^")_"^"_$P(Z,"^",2)_"^"_$P($G(^DIC(3.1,+$P(Z,"^",9),0)),"^")_"^"_$P(Y,"^",9)
22 Q X
23VCLERK(IFN,ACT) ;Get verifying clerk data
24 ;Returns 1^name^initials^title^date/time verified if data, "" if not
25 Q:'$G(IFN) ""
26 Q:'$D(^OR(100,IFN,0)) ""
27 N X,Y,Z S X=""
28 I $G(ACT) S Y=$$ACT(IFN,ACT),Z=$G(^VA(200,+$P(Y,"^",10),0)) I $L(Z) S X=1_"^"_$P(Z,"^")_"^"_$P(Z,"^",2)_"^"_$P($G(^DIC(3.1,+$P(Z,"^",9),0)),"^")_"^"_$P(Y,"^",11)
29 Q X
30RVIEW(IFN,ACT) ;Get Chart reviewed by data
31 ;Returns 1^name^initials^titel^date/time reviewed, "" if not
32 Q:'$G(IFN) ""
33 Q:'$D(^OR(100,IFN,0)) ""
34 N X,Y,Z S X=""
35 I $G(ACT) S Y=$$ACT(IFN,ACT),Z=$G(^VA(200,+$P(Y,"^",18),0)) I $L(Z) S X=1_"^"_$P(Z,"^")_"^"_$P(Z,"^",2)_"^"_$P($G(^DIC(3.1,+$P(Z,"^",9),0)),"^")_"^"_$P(Y,"^",19)
36 Q X
37ORDOC(IFN,ACT) ;Get Ordering provider
38 Q:'$G(IFN) ""
39 Q:'$D(^OR(100,IFN,0)) ""
40 N X,Y,Z
41 S X=""
42 I $G(ACT) S Y=$$ACT(IFN,ACT),Z=$G(^VA(200,+$P(Y,"^",3),0)) I $L(Z) S X=$P(Z,"^")
43 I '$L(X) S Y=$P(^OR(100,IFN,0),"^",4),Z=$G(^VA(200,+Y,0)) I $L(Z) S X=$P(Z,"^")
44 Q X
45PHONE(IFN,ACT,PIECE) ;Get Ordering provider's phone number (multiple choice)
46 ;PIECE=the piece of data to get from node ^VA(200,DUZ,.13)
47 Q:'$G(IFN) ""
48 Q:'$D(^OR(100,IFN,0)) ""
49 Q:'$G(PIECE)
50 N X,Y,Z
51 S X=""
52 I $G(ACT) S Y=$$ACT(IFN,ACT),Z=$G(^VA(200,+$P(Y,"^",3),.13)) I $L(Z) S X=$P(Z,"^",PIECE) Q X
53 S Y=$P(^OR(100,IFN,0),"^",4) S:Y X=$P($G(^VA(200,Y,.13)),"^",PIECE)
54 Q X
55NAT(IFN,ACT) ;Get Nature of order
56 Q:'$G(IFN) ""
57 Q:'$D(^OR(100,IFN,0)) ""
58 N X,Y
59 S X=""
60 I $G(ACT) S Y=$P($$ACT(IFN,ACT),"^",12),X=$S($D(^ORD(100.02,+Y,0)):$P(^(0),"^"),1:"")
61 Q X
62ESNAME(IFN,ACT) ;Get Electronic Sig Name
63 Q:'$G(IFN) ""
64 Q:'$D(^OR(100,IFN,0)) ""
65 N X,Y
66 S X=""
67 I $G(ACT) S Y=$$ACT(IFN,ACT) D Q X
68 . I $P(Y,"^",5) S X=$P($G(^VA(200,$P(Y,"^",5),20)),"^",2) S:$L(X) X=$S($P(Y,"^",4)=7:"/ds/",1:"/es/")_X Q
69 . I $P(Y,"^",4),"42"[$P(Y,"^",4) S X="_______________" Q
70 Q X
71ESTIT(IFN,ACT) ;Get Electronic Sig Title
72 Q:'$G(IFN) ""
73 Q:'$D(^OR(100,IFN,0)) ""
74 N X,Y
75 S X="" I $G(ACT) S Y=$$ACT(IFN,ACT) S:$P(Y,"^",5) X=$E($P($G(^VA(200,$P(Y,"^",5),20)),"^",3),1,20)
76 Q X
77ESDATE(IFN,ACT) ;Get Electronic Sig Date
78 Q:'$G(IFN) ""
79 Q:'$D(^OR(100,IFN,0)) ""
80 N X
81 S X=""
82 I $G(ACT) S X=$P($$ACT(IFN,ACT),"^",6)
83 Q X
84ESODATE(IFN,ACT) ;Get Date/time Signed online
85 Q:'$G(IFN) ""
86 Q:'$D(^OR(100,IFN,0)) ""
87 N X
88 S X=""
89 I $G(ACT),$P($$ACT(IFN,ACT),"^",4)=1 S X=$P($$ACT(IFN,ACT),"^",6)
90 Q X
91ENTBY(IFN,ACT) ;Get Entered by
92 Q:'$G(IFN) ""
93 Q:'$D(^OR(100,IFN,0)) ""
94 N X,Y
95 S X="" I $G(ACT) S Y=$$ACT(IFN,ACT) S:$P(Y,"^",13) X=$P($G(^VA(200,$P(Y,"^",13),0)),"^") Q X
96 S X=$P(^OR(100,IFN,0),"^",6) S:X X=$P(^VA(200,X,0),"^")
97 Q X
98ENTINT(IFN,ACT) ;Get Entered by Initials
99 Q:'$G(IFN) ""
100 Q:'$D(^OR(100,IFN,0)) ""
101 N X,Y
102 S X="" I $G(ACT) S Y=$$ACT(IFN,ACT) S:$P(Y,"^",13) X=$P($G(^VA(200,$P(Y,"^",13),0)),"^",2) Q X
103 S X=$P(^OR(100,IFN,0),"^",6) S:X X=$P(^VA(200,X,0),"^",2)
104 Q X
105ENTIT(IFN,ACT) ;Get Electronic Sig Title of Entering Person
106 Q:'$G(IFN) ""
107 Q:'$D(^OR(100,IFN,0)) ""
108 N X,Y
109 S X="" I $G(ACT) S Y=$$ACT(IFN,ACT) S:$P(Y,"^",13) X=$E($P($G(^VA(200,$P(Y,"^",13),20)),"^",3),1,20) Q X
110 S X=$P(^OR(100,IFN,0),"^",6) S:X X=$E($P(^VA(200,X,20),"^",3),1,20)
111 Q X
112BY(ORIFN) ;Get DC info for DC by & when PRINT FIELD
113 Q:'$G(ORIFN) ""
114 N Y,Z,X6,X1,ORDCBY
115 I $P($G(^OR(100,ORIFN,6)),"^",2) S X6=^(6) D Q ORDCBY
116 . S Y=+$J($P(X6,"^",3),0,4),Z=$G(^VA(200,+$P(X6,"^",2),0)) I $L(Z) S X1=$P(Z,"^")_$S($P(Z,"^",9):" ("_$E($P(^DIC(3.1,$P(Z,"^",9),0),"^"),1,10)_")",1:""),Y=$$DATE^ORU(Y)_" "_$$TIME^ORU(Y)
117 . S ORDCBY="DC'ed "_$S(+$P(X6,"^",4):"("_$P(^ORD(100.03,+$P(X6,"^",4),0),"^")_")",1:"")_" by:"_X1_" "_Y
118 Q ""
119WARDREM(ORIFN) ;Get Ward Remarks
120 N ORI,X
121 S X=""
122 I $G(ORIFN) S ORI=$O(^OR(100,ORIFN,4.5,"ID","COMMENT",0)) I ORI S X="^OR(100,"_+ORIFN_",4.5,"_ORI_",2)"
123 Q X
124RX(IFN,FLD,Y) ;Get Pharmacy Fields
125 ;IFN=internal # of 100
126 ;FLD=code for RX field to lookup
127 ;Y=output returned in Y
128 Q:'$G(IFN) Q:'$L($G(FLD))
129 Q:'$D(^OR(100,IFN,0))
130 N X,X4,PKG,DFN,I S X=^OR(100,IFN,0),X4=$G(^(4)) Q:'$L(X4)
131 S PKG=$P(X,"^",14) Q:'PKG
132 S PKG=$S($P(^DIC(9.4,PKG,0),"^")="INPATIENT MEDICATIONS":"I",$P(^(0),"^")="OUTPATIENT MEDICATIONS":"O",$P(^(0),"^")="IV MEDICATIONS":"I",$P(^(0),"^")="UNIT DOSE MEDICATIONS":"I",1:"") Q:'$L(PKG)
133 S DFN=+$P(X,"^",2)
134 D OEL^PSOORRL(DFN,X4_";"_PKG)
135 I FLD="SI" S Y=$P($G(^TMP("PS",$J,"SI")),"^",1,99) Q ;Special Instructions
136 I FLD="SCH" S I=0 D Q ;Schedule & Admin Times
137 . F S I=$O(^TMP("PS",$J,"SCH",I)) Q:I<1 S Y(I)=$P(^(I,0),"^") ;_" "_$P(^(0),"^",2)
138 I FLD="OTH" S Y=$P($G(^TMP("PS",$J,"OPI")),1,99) Q ;Other print info
139 I FLD="DRUG" S Y=$P($G(^TMP("PS",$J,0)),"^") Q ;Drug
140 I FLD="INF" S Y=$P($G(^TMP("PS",$J,0)),"^",2) Q ;Infusion rate
141 I FLD="STOP" S Y=$P($G(^TMP("PS",$J,0)),"^",3) Q ;Stop date
142 I FLD="REFIL" S Y=$P($G(^TMP("PS",$J,0)),"^",4) Q ;Refills
143 I FLD="MDRT" S I=0 D Q ;Med Route
144 . F S I=$O(^TMP("PS",$J,"MDR",I)) Q:I<1 S Y(I)=^(I,0)
145 I FLD="SIG" S I=0 D Q ;SIG (outpat) Instructions (inpat)
146 . F S I=$O(^TMP("PS",$J,"SIG",I)) Q:I<1 S Y(I)=^(I,0)
147 I FLD="PC" S I=0 D Q ;Provider comments
148 . F S I=$O(^TMP("PS",$J,"PC",I)) Q:I<1 S Y(I)=^(I,0)
149 I FLD="ADD" S I=0 D Q ;Additive, amount, bottle
150 . F S I=$O(^TMP("PS",$J,"A",I)) Q:I<1 S Y(I)=$P(^(I,0),"^")_" "_$P(^(0),"^",2)_" #"_$P(^(0),"^",3)
151 I FLD="SOL" S I=0 D Q ;Solution & amount
152 . F S I=$O(^TMP("PS",$J,"B",I)) Q:I<1 S Y(I)=$P(^(I,0),"^")_" "_$P(^(0),"^",2)
153 Q
154TEST ;Test RX call
155 W !,"Enter Pharmacy Order # (ORIFN): " R X:DTIME Q:X=""!(X["^") I '$D(^OR(100,+$G(X),0)) W !,$C(7),X_" does not exist" G TEST
156 S ORIFN=X F ORI="SCH","SI","ADM","OTH","DRUG","INF","STOP","REFIL","MDRT","SIG","PC","ADD","SOL" K TEST D RX(ORIFN,ORI,.TEST) I $D(TEST) W !,ORI_"- " ;ZW TEST
157 Q
158LABEL(Y,ORIFN,QUIET,OACTION) ;Print pharmacy label
159 I $G(ORTEST) D TEST1 Q
160 N X,X4,ORC
161 Q:'$D(^OR(100,+$G(ORIFN),0)) Q:'$L($G(^(4))) S X=^(0),X4=^(4)
162 I $S($P($G(^DIC(9.4,+$P(X,"^",14),0)),"^")="INPATIENT MEDICATIONS":0,$P($G(^DIC(9.4,+$P(X,"^",14),0)),"^")="IV MEDICATIONS":0,$P($G(^DIC(9.4,+$P(X,"^",14),0)),"^")="UNIT DOSE MEDICATIONS":0,1:1) Q
163 N LINES,ORXPTMP,I,ACT
164 I $G(OACTION),$D(^OR(100,+$G(ORIFN),8,OACTION,0)) S ACT=$P(^(0),"^",2)
165 I $L($T(MAR^PSJORMAR),",")>4 D MAR^PSJORMAR(+$P(X,"^",2),$P(X4,"^"),1,.LINES,$G(ACT))
166 I $L($T(MAR^PSJORMAR),",")'>4 D MAR^PSJORMAR(+$P(X,"^",2),$P(X4,"^"),1,.LINES)
167 I $G(QUIET) K Y S (I,Y)=0 D Q
168 . F S I=$O(LINES(I)) Q:'I S Y(I,0)=LINES(I),ORPICKUP=I
169 S (ORC,I)=0
170 I '$D(ORIOSL) N ORIOSL S ORIOSL=$S($D(IOSL):IOSL,1:50)
171 I '$D(ORIOF) N ORIOF S ORIOF=$S($D(IOF):IOF,1:"!")
172 F S I=$O(LINES(I)) Q:I<1 S ORC=ORC+1 D
173 . I $Y>(ORIOSL-2) W @ORIOF S ORC=1
174 . W:ORC>1 ! W LINES(I)
175 Q
176TEST1 ;Print test label
177 W !,"03/03 | | (F1990)|"
178 W !,"Test Pharmacy Label"
179 W !,"Give: 1GM TOP QD"
180 W !!," RPH: _____RN: _____|"
181 Q
Note: See TracBrowser for help on using the repository browser.