source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQPS.m@ 1774

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1ORQQPS ; 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
4LIST(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
56DETAIL(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
Note: See TracBrowser for help on using the repository browser.