source: ePrescribing/trunk/p/C0PCUR.m@ 1800

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

initial release of ePrescribing

File size: 7.9 KB
Line 
1C0PCUR ; VEN/SMH - Get current medications ; 5/8/12 9:24pm
2 ;;1.0;C0P;;Apr 25, 2012;Build 103
3 ;
4 ;Copyright 2009 Sam Habiel. Licensed under the terms of the GNU
5 ;General Public License See attached copy of the License.
6 ;
7 ;This program is free software; you can redistribute it and/or modify
8 ;it under the terms of the GNU General Public License as published by
9 ;the Free Software Foundation; either version 2 of the License, or
10 ;(at your option) any later version.
11 ;
12 ;This program is distributed in the hope that it will be useful,
13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;GNU General Public License for more details.
16 ;
17 ;You should have received a copy of the GNU General Public License along
18 ;with this program; if not, write to the Free Software Foundation, Inc.,
19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 ;
21GET(C0PMEDS,C0PDFN) ; Private Proc - Get Current C0PMEDS
22 ; Input:
23 ; C0PMEDS by reference
24 ; C0PDFN by Value
25 ; Output: (modified PSOORRL output)
26 ; C0PMEDS(D0,0): Order#_File;Pkg^Drug Name^Infusion Rate^Stop Date ^Refills Remaining^Total Dose^Units per Dose^Placer#^Status^Last Filldate^Days Supply^Qty^NOT TO BE GIVEN^Pending Renewal (1 or 0)
27 ; C0PMEDS(D0,"DRUG"): Drug IEN
28 ; C0PMEDS(D0,"A",0) = # of lines
29 ; C0PMEDS(D0,"A",D1,0) = Additive Name^Amount^Bottle
30 ; C0PMEDS(D0,"ADM",0) = # of lines
31 ; C0PMEDS(D0,"ADM",D1,0) = Administration Times
32 ; C0PMEDS(D0,"B",0) = # of lines
33 ; C0PMEDS(D0,"B",D1,0) = Solution Name^Amount
34 ; C0PMEDS(D0,"MDR",0) = # of lines
35 ; C0PMEDS(D0,"MDR",D1,0) = Medication Route abbreviation
36 ; C0PMEDS(D0,"P",0) = IEN^Name of Ordering Provider (#200)
37 ; C0PMEDS(D0,"SCH",0) = # of lines
38 ; C0PMEDS(D0,"SCH",D1,0) = Schedule Name
39 ; C0PMEDS(D0,"SIG",0) = # of lines
40 ; C0PMEDS(D0,"SIG",D1,0) = Sig (outpatient) or Instructions (inpatient)
41 ; C0PMEDS(D0,"SIO",0) = # of lines
42 ; C0PMEDS(D0,"SIO",D1,0) = Special Instructions/Other Print Info
43 ; C0PMEDS(D0,"START"): Start Date (timson)
44 ; added by gpl
45 ; C0PMEDS(D0,"NVAIEN") = IEN of the drug in the NVA subfile
46 ; C0PMEDS(D0,"COMMENTS") = First line of the comment WP field in NVA
47 K ^TMP("PS",$J)
48 N BEG,END,CTX
49 S (BEG,END,CTX)=""
50 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT C0PMEDS") ; PSOORRL defaults to 120d
51 I CTX=";" D DEL^XPAR("USR.`"_DUZ,"ORCH CONTEXT C0PMEDS")
52 S CTX=$$GET^XPAR("ALL","ORCH CONTEXT C0PMEDS")
53 S BEG=$$DT($P(CTX,";")),END=$$DT($P(CTX,";",2))
54 D OCL^PSOORRL(C0PDFN,BEG,END) ;DBIA #2400
55 M C0PMEDS=^TMP("PS",$J)
56 N C0PI S C0PI="" ; THIS IS THE RETURNED LIST OF MEDS
57 N ZI S ZI=0 ; THIS WILL BE THE MATCHING IEN IN THE NVA MULTIPLE
58 F S C0PI=$O(C0PMEDS(C0PI)) Q:C0PI="" D
59 . K ^TMP("PS",$J) ; again
60 . N LSIEN S LSIEN=$P(C0PMEDS(C0PI,0),U,1) ; LIST IEN xN;O OR xR;O gpl
61 . D OEL^PSOORRL(C0PDFN,LSIEN)
62 . S C0PMEDS(C0PI,"START")=$P(^TMP("PS",$J,0),U,5) ; Start Date in fm
63 . S:+$G(^TMP("PS",$J,"DD",1,0)) C0PMEDS(C0PI,"DRUG")=+^(0) ; Drug IEN
64 . ;I '$D(GPLTEST) Q ; let me test and others still work
65 . ; now go look for the NVAIEN in the subfile - gpl
66 . ;W !,"LSIEN "_LSIEN_"C0PI "_C0PI
67 . I $P(LSIEN,";",1)["N" D ; only for NVA drugs
68 . . ;N ZI S ZI=0
69 . . N FOUND S FOUND=0
70 . . ;F Q:FOUND=1 S ZI=$O(^PS(55,C0PDFN,"NVA",ZI)) Q:+ZI=0 D ;EACH NVA
71 . . S ZI=$O(^PS(55,C0PDFN,"NVA",ZI)) D ; NEXT NVA IEN (MAKE SURE IT MATCHES)
72 . . . N ZN S ZN=$NA(^PS(55,C0PDFN,"NVA",ZI))
73 . . . I '$D(@ZN@(0)) Q ; BAD NVA NODE
74 . . . I $P(@ZN@(0),U,2)=$G(C0PMEDS(C0PI,"DRUG")) S FOUND=1 ;DRUG NUMBERS MATCH
75 . . . E D ; CHECK FOR FREE TEXT DRUG MATCH
76 . . . . N Z1 S Z1=$P($P(@ZN@(0),U,3),"|",1) ; free txt drug from NVA
77 . . . . N Z2 S Z2=$P(C0PMEDS(C0PI,"SIG",1,0),"|",1) ; free txt from list
78 . . . . I Z1=Z2 S FOUND=1
79 . . . I FOUND=1 D ; found the NVA subfile entry
80 . . . . S C0PMEDS(C0PI,"NVAIEN")=ZI ; NVA ien
81 . . . . ;S C0PMEDS(C0PI,"COMMENTS")=$G(@ZN@(1,1,0)) ; first line of comments
82 . . . . N ZC ; to store the comment wp field
83 . . . . N ZM S ZM=$$GET1^DIQ(55.05,ZI_","_C0PDFN,14,,"ZC")
84 . . . . M C0PMEDS(C0PI,"COMMENTS")=ZC ; the comments
85 . . . . ;N ZC S ZC=0
86 . . . . ;F S ZC=$G(@ZN@(1,ZC)) Q:+ZC=0 D ; pull out the comments
87 . . . . ;. S C0PMEDS(C0PI,"COMMENTS",ZC)=$G(@ZN@(1,ZC,0)) ;line of comment
88 . . . . ;M C0PMEDS(C0PI,"COMMENTS")=@ZN@(1) ; all the lines of comments
89 . . . E D ; ERROR .. THESE SHOULD MATCH. There is a bug.
90 . . . . D ERROR^C0PMAIN(",U113059007,",$ST($ST,"PLACE"),"ERX-NVA","Non-VA Meds Error") QUIT
91 QUIT
92DT(X) ; -- Returns FM date for X
93 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
94 Q Y
95 ;
96MEDLIST(ZMLIST,ZDFN,ZPARMS,NOERX,SUMMARY) ; RETURNS THE MEDLIST FOR PATIENT DFN
97 ; USES C0C PACKAGE ROUTINES TO PULL ALL MEDS FOR THE PATIENT
98 ; IF NOERX=1 IT WILL FILTER OUT EPRESCRIBING MEDS FROM THE LIST
99 ; SUMMARY IS PASSED BY NAME AND IS THE PLACE TO PUT A SUMMARY IF PROVIDED
100 N ZCCRT,ZCCRR
101 D INITXPF^C0PWS1("C0PF") ; SET FILE NUMBER AND PARAMATERS
102 D GETTEMP^C0CMXP("ZCCRT","CCRMEDS","C0PF")
103 K ^TMP("C0CRIM","VARS",ZDFN) ; KILL RIM VARIABLES TO MAKE SURE THEY ARE FRESH
104 I '$D(ZPARMS) S ZPARMS="MEDALL"
105 D SET^C0CPARMS(ZPARMS) ; SET PARAMATER TO PULL ALL MEDS
106 I '$D(DEBUG) S DEBUG=0
107 D EXTRACT^C0CMED("ZCCRT",ZDFN,"ZCCRR")
108 M @ZMLIST=^TMP("C0CRIM","VARS",ZDFN,"MEDS")
109 I $G(SUMMARY)="" Q ; NO SUMMARY NEEDED
110 S ZI=""
111 F S ZI=$O(@ZMLIST@(ZI)) Q:ZI="" D ;
112 . S @SUMMARY@(ZI,"MED")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMETEXT"))
113 . ;W @SUMMARY@(ZI,"MED")
114 . S @SUMMARY@(ZI,"STATUS")=$G(@ZMLIST@(ZI,"MEDSTATUSTEXT"))
115 . S @SUMMARY@(ZI,"CODESYSTEM")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMECODINGINGSYSTEM"))
116 . S @SUMMARY@(ZI,"CODE")=$G(@ZMLIST@(ZI,"MEDPRODUCTNAMECODEVALUE"))
117 . S @SUMMARY@(ZI,"COMMENT")=$G(@ZMLIST@(ZI,"MEDFULLFILLMENTINSTRUCTIONS"))
118 Q
119 ;
120ANALYZE(ZSTR,ZNUM) ; ANALYZE MED LISTS FOR ZNUM PATIENTS STARTING AT
121 ; PATIENT ZSTR. IF ZSTR="" START WHERE WE LEFT OFF
122 ; FIRST TIME, START WITH THE FIRST PATIENT
123 N C0PZI
124 I ZSTR="" D ; WANT TO START WHERE WE LEFT OFF OR AT THE FIRST PATIENT
125 . S C0PZI=$G(^TMP("C0PAMED","LAST"))
126 . I C0PZI="" S C0PZI=0
127 . S C0PZI=$O(^DPT(C0PZI)) ; FIRST PATIENT TO DO
128 E S C0PZI=ZSTR ; STARTING PATIENT IS SPECIFIED
129 N SUMM
130 N ZN S ZN=0
131 N DONE S DONE=0
132 F ZN=1:1:ZNUM Q:DONE D ; TRY AND DO ZNUM PATIENTS
133 . W !,"C0PZI=",C0PZI
134 . I +C0PZI=0 S DONE=1 Q ; OUT OF PATIENTS
135 . S SUMM=$NA(^TMP("C0PAMED",C0PZI)) ; PLACE TO PUT SUMMARY
136 . W "SUMM ",SUMM
137 . K G ; MED LIST RETURN VARIABLE
138 . D MEDLIST("G",C0PZI,"MEDACTIVE",,SUMM) ; PULL THE MEDS FOR THIS PATIENT
139 . S ^TMP("C0PAMED","LAST")=C0PZI ; SAVE WHERE WE ARE
140 . S C0PZI=$O(^DPT(C0PZI)) ; NEXT PATIENT
141 Q
142 ;
143RESET ; CLEAR OUT THE ANALYZE ARRAY
144 K ^TMP("C0PAMED")
145 Q
146 ;
147INDEX ; INDEX THE ANALYSES
148 N ZI,ZJ
149 S (ZI,ZJ)=""
150 F S ZI=$O(^TMP("C0PAMED",ZI)) Q:ZI="" D ;
151 . S ZJ=""
152 . F S ZJ=$O(^TMP("C0PAMED",ZI,ZJ)) Q:ZJ="" D ;
153 . . N ZMED
154 . . S ZMED=$G(^TMP("C0PAMED",ZI,ZJ,"MED"))
155 . . I ZMED'="" S ^TMP("C0PAMED","MED",ZMED,ZI)=""
156 . . N ZCODE
157 . . S ZCODE=$G(^TMP("C0PAMED",ZI,ZJ,"CODE"))
158 . . I ZCODE'="" S ^TMP("C0PAMED","CODE",ZCODE,ZI)=""
159 D COUNT
160 Q
161 ;
162COUNT ; COUNT THE MEDS AND THE CODES
163 N ZI,ZN S ZN=0
164 S ZI=""
165 F S ZI=$O(^TMP("C0PAMED","MED",ZI)) Q:ZI="" D ;
166 . S ZN=ZN+1
167 W !,"MED COUNT: ",ZN
168 S ZN=0
169 S ZI=""
170 F S ZI=$O(^TMP("C0PAMED","CODE",ZI)) Q:ZI="" D ;
171 . S ZN=ZN+1
172 W !,"CODE COUNT: ",ZN
173 Q
174 ;
175 ; NB: EP below not used in C0P 1.0 --smh 5/9/2012
176OUTSIDE(ZRTN,ZMEDS) ; WRAP THE MEDS IN THE OUTSIDEPRESRIPTION XML
177 ; Here's what the xml looks like. It's stored in the Template field
178 ; of the OUTSIDEPRESCRIPTION record in file C0P XML TEMPLATE file
179 ;<OutsidePrescription>
180 ; <externalId>@@PRESCRIPTIONID@@</externalId>
181 ; <date>@@MEDDATE@@</date>
182 ; <doctorName>@@DOCTORNAME@@</doctorName>
183 ; <drug>@@MEDTEXT@@</drug>
184 ; <dispenseNumber>@@DISPENSENUMBER@@</dispenseNumber>
185 ; <sig>@@SIG@@</sig>
186 ; <refillCount>@@REFILLCOUNT@@</refillCount>
187 ; <prescriptionType>@@PRESCRIPTIONTYPE@@</prescriptionType>
188 ;</OutsidePrescription>
189 N C0PZI,ZTEMP,C0PF
190 S C0PZI=""
191 D INITXPF^C0PWS1("C0PF") ; SET UP FILE POINTERS
192 D GETTEMP^C0CMXP("ZTEMP","OUTSIDEPRESCRIPTION","C0PF")
193 ; BREAK
194 Q
Note: See TracBrowser for help on using the repository browser.