| [1595] | 1 | C0PCUR ; 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 | ;
|
|---|
| 21 | GET(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
|
|---|
| 92 | DT(X) ; -- Returns FM date for X
|
|---|
| 93 | N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
|
|---|
| 94 | Q Y
|
|---|
| 95 | ;
|
|---|
| 96 | MEDLIST(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 | ;
|
|---|
| 120 | ANALYZE(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 | ;
|
|---|
| 143 | RESET ; CLEAR OUT THE ANALYZE ARRAY
|
|---|
| 144 | K ^TMP("C0PAMED")
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
| 147 | INDEX ; 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 | ;
|
|---|
| 162 | COUNT ; 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
|
|---|
| 176 | OUTSIDE(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
|
|---|
