source: ePrescribing/trunk/p/C0PWPS.m@ 1676

Last change on this file since 1676 was 1595, checked in by George Lilly, 12 years ago

initial release of ePrescribing
File size: 6.7 KB
Line 
1C0PWPS ; ERX/GPL - eRx CPRS RPCs ; 2/8/10 ; 5/8/12 5:24pm
2 ;;1.0;C0P;;Apr 25, 2012;Build 103
3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21 ; These routines are substitutes for COVER^ORWPS and DETAIL^ORWPS to
22 ; display eRx and CCR/CCD medication lists accurately
23 ;
24COVER(LST,DFN) ; retrieve meds for cover sheet
25 K ^TMP("PS",$J)
26 D OCL^PSOORRL(DFN,"","") ;DBIA #2400
27 N ILST,ITMP,X S ILST=0
28 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D
29 . S X=^TMP("PS",$J,ITMP,0)
30 . I '$L($P(X,U,2)) S X="??" ; show something if drug empty
31 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
32 . E S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
33 K ^TMP("PS",$J)
34 ; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
35 N ZCUR
36 D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
37 N ZI S ZI=""
38 F S ZI=$O(LST(ZI)) Q:ZI="" D ;FOR EACH MED IN THE LIST
39 . I $P(LST(ZI),U,2)["FREE TXT" D ; IS AN ERX UNMAPPED DRUG
40 . . N ZD
41 . . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
42 . . ; SEPARATED BY "|"
43 . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
44 ; BEGIN VISTACOM MOD -
45 ; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
46 S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
47 Q
48COVER2(LST,DFN) ; retrieve meds for cover sheet ;
49 ; THIS VERSION WILL DISPLAY THE DRUG NAME FROM THE PHARMACY ORDERABLE
50 ; ITEMS FILE FOR ERX DRUGS. THIS ALLOWS THE DRUG TO APPEAR AS GENERIC(BRAND)
51 ; FOR CERTAIN DRUGS - GPL 10/5/10
52 K ^TMP("PS",$J)
53 D OCL^PSOORRL(DFN,"","") ;DBIA #2400
54 N ILST,ITMP,X S ILST=0
55 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D
56 . S X=^TMP("PS",$J,ITMP,0)
57 . I '$L($P(X,U,2)) S X="??" ; show something if drug empty
58 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
59 . E S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
60 K ^TMP("PS",$J)
61 ; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
62 N ZCUR
63 D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
64 N ZI S ZI=""
65 F S ZI=$O(LST(ZI)) Q:ZI="" D ;FOR EACH MED IN THE LIST
66 . I $P(LST(ZI),U,2)["FREE TXT" D ; IS AN ERX UNMAPPED DRUG
67 . . N ZD
68 . . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
69 . . ; SEPARATED BY "|"
70 . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
71 . E I $P(LST(ZI),U,1)["N" D ; THIS IS A NONVA DRUG
72 . . N ZD,ZDIEN
73 . . I $G(ZCUR(ZI,"COMMENTS",1))["E-Rx" D ; IS AN ERX DRUG
74 . . . S ZDIEN=$G(ZCUR(ZI,"DRUG")) ; IEN IN THE DRUG FILE
75 . . . S ZD=$$GET1^DIQ(50,ZDIEN,2.1) ; THE PHARMACY ORDERABLE ITEM
76 . . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; USE THIS DRUG NAME
77 ; BEGIN VISTACOM MOD -
78 ; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
79 S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
80 Q
81COVER3(LST,DFN) ; retrieve meds for cover sheet ;
82 ; THIS VERSION WILL DISPLAY THE FIRST DATA BANK DRUG NAME WHERE AVAILABLE
83 ; - GPL 10/6/10
84 K ^TMP("PS",$J)
85 D OCL^PSOORRL(DFN,"","") ;DBIA #2400
86 N ILST,ITMP,X S ILST=0
87 S ITMP="" F S ITMP=$O(^TMP("PS",$J,ITMP)) Q:'ITMP D
88 . S X=^TMP("PS",$J,ITMP,0)
89 . I '$L($P(X,U,2)) S X="??" ; show something if drug empty
90 . I $D(^TMP("PS",$J,ITMP,"CLINIC",0)) S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)_U_"C"
91 . E S LST($$NXT^ORWPS)=$P(X,U,1,2)_U_$P(X,U,8,9)
92 K ^TMP("PS",$J)
93 ; BEGIN NEW PROCESSING (EVERYTHING ABOVE WAS COPIED FROM COVER^0RWPS
94 N ZCUR
95 D GET^C0PCUR(.ZCUR,DFN) ; GET THE DETAIL FOR THE SAME MEDS LIST
96 N ZI S ZI=""
97 F S ZI=$O(LST(ZI)) Q:ZI="" D ;FOR EACH MED IN THE LIST
98 . I $P(LST(ZI),U,2)["FREE TXT" D ; IS AN ERX UNMAPPED DRUG
99 . . N ZD
100 . . S ZD=$P(ZCUR(ZI,"SIG",1,0),"|",1) ; REAL DRUG NAME SHOULD BE IN SIG
101 . . ; SEPARATED BY "|"
102 . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE REAL NAME
103 . E I $P(LST(ZI),U,1)["N" D ; THIS IS A NONVA DRUG
104 . . N ZD,ZDSIG
105 . . S ZDSIG=ZCUR(ZI,"SIG",1,0) ; THE SIG (CHECK THIS PLEASE)
106 . . I ZDSIG["|" D ; THERE ARE TWO PARTS TO THE SIG
107 . . . S ZD=$P(ZDSIG,"|",1) ; FDB DRUG NAME SHOULD BE IN SIG
108 . . . I ZD'="" S $P(LST(ZI),U,2)=ZD ; IF SO, USE THE FDB NAME
109 ; BEGIN VISTACOM MOD -
110 ; SAVE THE DUZ OFF TO THE VISTACOM TMP GLOBAL
111 S ^TMP("ZEWD",$J,"DUZ")=DUZ ; TO BE PICKED UP AND DELETED LATER BY VISTACOM
112 Q
113DETAIL(ROOT,DFN,ID) ; -- show details for a med order
114 K ^TMP("ORXPND",$J)
115 N ZID
116 S ZID=ID
117 N LCNT,ORVP
118 S LCNT=0,ORVP=DFN_";DPT("
119 D MEDS^ORCXPND1
120 S ROOT=$NA(^TMP("ORXPND",$J))
121 I @ROOT@(11,0)="Order #0" D ERXDET
122 Q
123ERXDET ; BUILD ERX MED DETAIL
124 N ZMEDS
125 D GET^C0PCUR(.ZMEDS,DFN)
126 N ZI,FOUND
127 S FOUND=0 S ZI=""
128 F Q:FOUND'=0 S ZI=$O(ZMEDS(ZI)) Q:ZI="" D ; SEARCH FOR THE ID
129 . I $P(ZMEDS(ZI,0),U,1)=ZID S FOUND=1 ; ID MATCHES THE MED
130 I FOUND=0 Q ; NO MATCH FOR THE MED
131 K @ROOT ; CLEAR OUT THE NULL DETAIL
132 ;W !,"MED FOUND ",ZI," ",ZID
133 N ZNAME,ZSIG,ZCOM,ZFDBN
134 S ZNAME=$P(ZMEDS(ZI,0),U,2)
135 S ZSIG=$G(ZMEDS(ZI,"SIG",1,0))
136 M ZCOM=ZMEDS(ZI,"COMMENTS")
137 I ZNAME["FREE TXT" D ;
138 . S ZNAME=$P(ZSIG,"|",1)
139 . S ZSIG=$P(ZSIG,"| ",2)
140 E I ZSIG["|" D ; NEED TO PULL OUT THE DRUG NAME FROM THE SIG
141 . S ZFDBN=$P(ZSIG,"|",1)
142 . S ZSIG=$P(ZSIG,"| ",2)
143 N ZN S ZN=1
144 S @ROOT@(ZN,0)=" Medication: "_ZNAME S ZN=ZN+1
145 I $G(ZFDBN)'="" D ; IF FIRST DATA BANK NAME IS KNOWN
146 . S @ROOT@(ZN,0)=" " S ZN=ZN+1
147 . S @ROOT@(ZN,0)=" FDB Name: "_ZFDBN S ZN=ZN+1
148 . S @ROOT@(ZN,0)=" " S ZN=ZN+1
149 E S @ROOT@(ZN,0)=" " S ZN=ZN+1
150 S @ROOT@(ZN,0)=" Sig: "_ZSIG S ZN=ZN+1
151 S @ROOT@(ZN,0)="" S ZN=ZN+1
152 S @ROOT@(ZN,0)=" Status: "_$P(ZMEDS(ZI,0),U,9) S ZN=ZN+1
153 S @ROOT@(ZN,0)="" S ZN=ZN+1
154 S @ROOT@(ZN,0)=" Schedule: "_$G(ZMEDS(ZI,"SCH",1,0)) S ZN=ZN+1
155 S @ROOT@(ZN,0)=" " S ZN=ZN+1
156 S @ROOT@(ZN,0)=" Start Date: "_$$FMTE^XLFDT($G(ZMEDS(ZI,"START"))) S ZN=ZN+1
157 S @ROOT@(ZN,0)=" " S ZN=ZN+1
158 S @ROOT@(ZN,0)=" Source: ePrescribing " S ZN=ZN+1
159 S @ROOT@(ZN,0)=" " S ZN=ZN+1
160 N ZI S ZI=""
161 F S ZI=$O(ZCOM(ZI)) Q:ZI="" D ;
162 . S @ROOT@(12+ZI,0)=ZCOM(ZI) ;COMMENT LINE
163 Q
164 ;
Note: See TracBrowser for help on using the repository browser.