1 | ORQQPS ; slc/CLA - Functions which return patient medication data ;12/15/97 [ 04/02/97 3:52 PM ]
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,94**;Dec 17, 1997
|
---|
3 | Q
|
---|
4 | LIST(ORY,ORPT,ORSTRTDT,ORSTOPDT) ;return pt's condensed medication list
|
---|
5 | ;id^nameform^stop date^route^schedule/infusion rate^refills remaining
|
---|
6 | K ^TMP("PS",$J),^TMP("ORPS",$J)
|
---|
7 | D OCL^PSOORRL(ORPT,ORSTRTDT,ORSTOPDT)
|
---|
8 | N I,J,K,X,Z,ZZ,NODE,RSORT,NAME,SCH,MDR,RATE,TYPE,ADD,SOL,IVX
|
---|
9 | S I=0,X=0,NODE=0,SCH="",MDR=""
|
---|
10 | F S X=$O(^TMP("PS",$J,X)) Q:X<1 D
|
---|
11 | .Q:+$P(^TMP("PS",$J,X,0),U)<1
|
---|
12 | .S TYPE=$P(^TMP("PS",$J,X,0),U)
|
---|
13 | .I +$G(^TMP("PS",$J,X,"MDR",0))>0 D ;get abbrev med route
|
---|
14 | ..S ZZ=^TMP("PS",$J,X,"MDR",0) F Z=1:1:ZZ D
|
---|
15 | ...I Z=1 S MDR=^TMP("PS",$J,X,"MDR",Z,0)
|
---|
16 | ...E S MDR=MDR_", "_^TMP("PS",$J,X,"MDR",Z,0)
|
---|
17 | .I +$G(^TMP("PS",$J,X,"SCH",0))>0 D ;get schedule
|
---|
18 | ..S ZZ=^TMP("PS",$J,X,"SCH",0) F Z=1:1:ZZ D
|
---|
19 | ...I Z=1 S SCH=$P(^TMP("PS",$J,X,"SCH",Z,0),U)
|
---|
20 | ...E S SCH=SCH_", "_$P(^TMP("PS",$J,X,"SCH",Z,0),U)
|
---|
21 | .;
|
---|
22 | .I TYPE["I",+$G(^TMP("PS",$J,X,"B",0))>0 D ;IV meds - get solution
|
---|
23 | ..S ZZ=^TMP("PS",$J,X,"B",0) F Z=1:1:ZZ D
|
---|
24 | ...I Z=1 S SOL=$P(^TMP("PS",$J,X,"B",Z,0),U)_" "_$P(^(0),U,2)
|
---|
25 | ...E S SOL=SOL_", "_$P(^TMP("PS",$J,X,"B",Z,0),U)_" "_$P(^(0),U,2)
|
---|
26 | ..I +$G(^TMP("PS",$J,X,"A",0))>0 D ;get additive
|
---|
27 | ...S ZZ=^TMP("PS",$J,X,"A",0) F Z=1:1:ZZ D
|
---|
28 | ....S ADD=$P(^TMP("PS",$J,X,"A",Z,0),U)_" "_$P(^(0),U,2)
|
---|
29 | ....S NAME=ADD_" in "_$G(SOL)
|
---|
30 | ....S RSORT=9999999-$P(^TMP("PS",$J,X,0),U,4)_$P(^(0),U)_NAME
|
---|
31 | ....S RSORT=$E(RSORT,1,128) ;limit gbl subscript length to 128 chars
|
---|
32 | ....S ^TMP("ORPS",$J,RSORT)=$P(^TMP("PS",$J,X,0),U)_U_NAME_U_$P(^(0),U,4)_U_$G(MDR)_U_$P(^(0),U,3)
|
---|
33 | ..E D
|
---|
34 | ...S NAME=$G(SOL)
|
---|
35 | ...S RSORT=9999999-$P(^TMP("PS",$J,X,0),U,4)_$P(^(0),U)
|
---|
36 | ...S RSORT=$E(RSORT,1,128) ;limit gbl subscript length to 128 chars
|
---|
37 | ...S ^TMP("ORPS",$J,RSORT)=$P(^TMP("PS",$J,X,0),U)_U_NAME_U_$P(^(0),U,4)_U_$G(MDR)_U_$P(^(0),U,3)
|
---|
38 | .;
|
---|
39 | .I TYPE["I",'(+$G(^TMP("PS",$J,X,"B",0))>0) D ;unit dose inpatient meds
|
---|
40 | ..S RSORT=9999999-$P(^TMP("PS",$J,X,0),U,4)_$P(^(0),U)_$P(^(0),U,2)
|
---|
41 | ..S RSORT=$E(RSORT,1,128) ;limit gbl subscript length to 128 chars
|
---|
42 | ..S ^TMP("ORPS",$J,RSORT)=$P(^TMP("PS",$J,X,0),U)_U_$P(^(0),U,2)_U_$P(^(0),U,4)_U_$G(MDR)_U_$G(SCH)
|
---|
43 | .;
|
---|
44 | .I TYPE["O" D ;outpatient meds
|
---|
45 | ..S RSORT=9999999-$P(^TMP("PS",$J,X,0),U,4)_$P(^(0),U)_$P(^(0),U,2)
|
---|
46 | ..S RSORT=$E(RSORT,1,128) ;limit gbl subscript length to 128 chars
|
---|
47 | ..S ^TMP("ORPS",$J,RSORT)=$P(^TMP("PS",$J,X,0),U)_U_$P(^(0),U,2)_U_$P(^(0),U,4)_U_$G(MDR)_U_$G(SCH)_U_$P(^(0),U,5)
|
---|
48 | .;
|
---|
49 | ;
|
---|
50 | F S NODE=$O(^TMP("ORPS",$J,NODE)) Q:NODE<1 D
|
---|
51 | .S I=I+1
|
---|
52 | .S ORY(I)=^TMP("ORPS",$J,NODE)
|
---|
53 | S:+$G(ORY(1))<1 ORY(1)="^No medications found."
|
---|
54 | K ^TMP("PS",$J),^TMP("ORPS",$J)
|
---|
55 | Q
|
---|
56 | DETAIL(ORY,ORPT,ORMED) ; return detailed information for a drug
|
---|
57 | K ^TMP("PS",$J)
|
---|
58 | D OEL^PSOORRL(ORPT,ORMED)
|
---|
59 | N I,J,CR,X,Z,ZZ,MDR,SCH,SIG,COM,ADD,SOL,ORDATE,TYPE
|
---|
60 | S I=0,J=1,CR=$CHAR(13),ORDATE=""
|
---|
61 | S TYPE=$P(ORMED,";",2)
|
---|
62 | S X=$G(^TMP("PS",$J,0))
|
---|
63 | I '$L($G(X)) S ORY(J)="No detailed information found." Q
|
---|
64 | S ORY(J)=" "_$P(X,U)
|
---|
65 | ;get abbreviated med route(s):
|
---|
66 | I +$G(^TMP("PS",$J,"MDR",0))>0 D
|
---|
67 | .S ZZ=^TMP("PS",$J,"MDR",0) F Z=1:1:ZZ D
|
---|
68 | ..I Z=1 S MDR=^TMP("PS",$J,"MDR",Z,0)
|
---|
69 | ..E S MDR=MDR_", "_^TMP("PS",$J,"MDR",Z,0)
|
---|
70 | I $L($G(MDR)) S ORY(J)=ORY(J)_" "_MDR
|
---|
71 | S ORY(J)=ORY(J)_" "_$P(X,U,2)
|
---|
72 | ; get schedule(s):
|
---|
73 | I +$G(^TMP("PS",$J,"SCH",0))>0 D
|
---|
74 | .S ZZ=^TMP("PS",$J,"SCH",0) F Z=1:1:ZZ D
|
---|
75 | ..I Z=1 S SCH=$P(^TMP("PS",$J,"SCH",Z,0),U)
|
---|
76 | ..E S SCH=SCH_", "_$P(^TMP("PS",$J,"SCH",Z,0),U)
|
---|
77 | I $L($G(SCH)) S ORY(J)=ORY(J)_" "_SCH
|
---|
78 | S ORY(J)=ORY(J),J=J+1
|
---|
79 | ; get SIG(s):
|
---|
80 | I +$G(^TMP("PS",$J,"SIG",0))>0 D
|
---|
81 | .S ZZ=^TMP("PS",$J,"SIG",0) F Z=1:1:ZZ D
|
---|
82 | ..I Z=1 S SIG=^TMP("PS",$J,"SIG",Z,0)
|
---|
83 | ..E S SIG=SIG_", "_^TMP("PS",$J,"SIG",Z,0)
|
---|
84 | I $L($G(SIG)) S ORY(J)=" "_SIG,J=J+1
|
---|
85 | S ORY(J)=" ",J=J+1
|
---|
86 | ; get solution(s):
|
---|
87 | I +$G(^TMP("PS",$J,"B",0))>0 D
|
---|
88 | .S ZZ=^TMP("PS",$J,"B",0) F Z=1:1:ZZ D
|
---|
89 | ..S SOL=^TMP("PS",$J,"B",Z,0),ORY(J)=" "_$P(SOL,U)_" "_$P(SOL,U,2),J=J+1
|
---|
90 | ; get additive(s):
|
---|
91 | I +$G(^TMP("PS",$J,"A",0))>0 D
|
---|
92 | .S ZZ=^TMP("PS",$J,"A",0) F Z=1:1:ZZ D
|
---|
93 | ..S ADD=^TMP("PS",$J,"A",Z,0)
|
---|
94 | ..S ORY(J)=" "_$P(ADD,U)
|
---|
95 | ..S IVX=$P(ADD,U,2)
|
---|
96 | ..S ORY(J)=ORY(J)_$S($D(IVX):" "_IVX,1:"")_" "_$P(ADD,U,3),J=J+1
|
---|
97 | I $L($G(SOL))!($L($G(ADD))) S ORY(J)=" ",J=J+1
|
---|
98 | ; get other information:
|
---|
99 | S ORY(J)=" Status: "_$P(X,U,6),J=J+1
|
---|
100 | S ORDATE=$P(X,U,5) I $L($G(ORDATE)) D
|
---|
101 | .D DT^DILF("ET",ORDATE,.ORDATE,"","")
|
---|
102 | S ORY(J)=" Start date: "_$G(ORDATE(0)),J=J+1
|
---|
103 | S ORDATE=$P(X,U,3) I $L($G(ORDATE)) D
|
---|
104 | .D DT^DILF("ET",ORDATE,.ORDATE,"","")
|
---|
105 | S ORY(J)=" Stop date: "_$G(ORDATE(0)),J=J+1
|
---|
106 | I TYPE="O" D ; if outpatient med
|
---|
107 | .S ORY(J)="Refills remaining: "_$P(X,U,4),J=J+1
|
---|
108 | .S ORY(J)=" Days supply: "_$P(X,U,7),J=J+1
|
---|
109 | .S ORY(J)=" Quantity: "_$P(X,U,8),J=J+1
|
---|
110 | .S ORY(J)=" ",J=J+1
|
---|
111 | S ORY(J)="Comments:",J=J+1
|
---|
112 | S I=0 F S I=$O(^TMP("PS",$J,"PC",I)) Q:'I D
|
---|
113 | .S ORY(J)=^TMP("PS",$J,"PC",I,0),J=J+1
|
---|
114 | K ^TMP("PS",$J)
|
---|
115 | Q
|
---|