| [1595] | 1 | C0PRECON ; VEN/SMH - Utilities for Medication Reconciliation; 5/8/12 4:34pm
|
|---|
| 2 | ;;1.0;C0P;;Apr 25, 2012;Build 103
|
|---|
| 3 | ;Copyright 2009 Sam Habiel. 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 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | GETMEDS(C0PDUZ,C0PDFN,ZRTN) ; Public Proc
|
|---|
| 22 | ; Retreives meds from WebService, matches them against VistA,
|
|---|
| 23 | ; compares them with current meds, saves into Non-Va multiple in file 55
|
|---|
| 24 | ; (pharmacy patient)
|
|---|
| 25 | ;
|
|---|
| 26 | ; Input:
|
|---|
| 27 | ; - C0PDUZ: DUZ
|
|---|
| 28 | ; - C0PDFN: DFN
|
|---|
| 29 | ;
|
|---|
| 30 | I $G(^TMP("C0PNOPULLBACK")) Q ; TURNS OFF PULLBACK PROCESSING
|
|---|
| 31 | ; FOR TESTING NEW CROP OPTIONS - KEEPS VISTA ERX DRUGS INTACT AND ADDS NO
|
|---|
| 32 | ; NEW DRUGS
|
|---|
| 33 | N C0PWSMEDS
|
|---|
| 34 | D SOAP^C0PWS1("C0PWSMEDS","GETMEDS",C0PDUZ,C0PDFN) ; soap call for WS meds
|
|---|
| 35 | I C0PWSMEDS(1,"Status")'="OK" Q ; bad return from ws call
|
|---|
| 36 | N CURRENTMEDS
|
|---|
| 37 | D GET^C0PCUR(.CURRENTMEDS,C0PDFN) ; current meds in VistA
|
|---|
| 38 | N ZDUPS ; ARRAY TO KEEP TRACK OF DUPLICATES SO THAT WE CAN
|
|---|
| 39 | ; DISCONTINUE ERX MEDS THAT ARE NOT IN THE WEB SERVICE LIST
|
|---|
| 40 | N I
|
|---|
| 41 | FOR I=1:1:C0PWSMEDS(1,"RowCount") DO
|
|---|
| 42 | . N MEDTOADD M MEDTOADD=C0PWSMEDS(I)
|
|---|
| 43 | . N DUPID S DUPID=$$DUP(MEDTOADD("DrugID"),.CURRENTMEDS) ; check for dups
|
|---|
| 44 | . N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
|
|---|
| 45 | . I 'DUPID S DUPID=$$FREMAT(MEDTXT,.CURRENTMEDS) ;check
|
|---|
| 46 | . ; for free text drug match gpl
|
|---|
| 47 | . I DUPID S ZDUPS(DUPID,I)="" ; INDEX BY CURRENT MED NUMBER
|
|---|
| 48 | . I DUPID D ; if indeed duplicate, check if WS Drug is newer drug
|
|---|
| 49 | . . N RXDATENOTIME
|
|---|
| 50 | . . S RXDATENOTIME=$P($$FMDATE(MEDTOADD("PrescriptionDate")),".")
|
|---|
| 51 | . . I RXDATENOTIME>CURRENTMEDS(DUPID,"START") D ; if newer
|
|---|
| 52 | . . . ;D DC^C0PNVA(C0PDFN,$P(CURRENTMEDS(DUPID,0),U)) ;dc old one
|
|---|
| 53 | . . . D DC^C0PNVA(C0PDFN,CURRENTMEDS(DUPID,"NVAIEN")) ; gpl
|
|---|
| 54 | . . . D ADD(.MEDTOADD,C0PDFN,C0PDUZ) ; add new one
|
|---|
| 55 | . . E ; do nothing here: Current med in Vista is newer or equivalent one
|
|---|
| 56 | . E D ADD(.MEDTOADD,C0PDFN,C0PDUZ) ; not a duplicate med
|
|---|
| 57 | ; NOW LOOK THROUGH CURRENT MEDS TO SEE WHICH NEED TO BE DISCONTINUED
|
|---|
| 58 | S I=""
|
|---|
| 59 | F S I=$O(CURRENTMEDS(I)) Q:I="" D ; FOR EACH CURRENT MED
|
|---|
| 60 | . I $O(ZDUPS(I,""))="" D ; DUPLICATE DRUG NOT FOUND
|
|---|
| 61 | . . I $P(CURRENTMEDS(I,0),U,9)'="ACTIVE" Q ; might be discontinued
|
|---|
| 62 | . . S ZT=$$DRUGNAM^C0PLKUP(.CURRENTMEDS,I)
|
|---|
| 63 | . . I ZT="" S ZT=$P(CURRENTMEDS(I,0),U,2)
|
|---|
| 64 | . . N ZN S ZN=$P($G(CURRENTMEDS(I,0)),U,1)
|
|---|
| 65 | . . S ZT=ZN_" "_ZT
|
|---|
| 66 | . . ;S ZT=$P(CURRENTMEDS(I,0),U,1)_" "_$P(CURRENTMEDS(I,0),U,2)
|
|---|
| 67 | . . I ZN["N;" D ; DISCONTINUE THE NONVA MED
|
|---|
| 68 | . . . I $G(CURRENTMEDS(I,"COMMENTS",1))["Received from E-Rx Web Service" D ;
|
|---|
| 69 | . . . . D DC^C0PNVA(C0PDFN,CURRENTMEDS(I,"NVAIEN")) ;dc the med
|
|---|
| 70 | . . . . S ZT="Discontinued "_ZT
|
|---|
| 71 | . . E S ZT="Can't Discontinue "_ZT
|
|---|
| 72 | . . D MAPERR(.ZRTN,"DRUGS",ZT)
|
|---|
| 73 | QUIT
|
|---|
| 74 | ADD(MEDTOADD,C0PDFN,C0PDUZ) ; Private Proc - Add med to VistA
|
|---|
| 75 | ; Input:
|
|---|
| 76 | ; - MEDTOADD: WebService Drug information, by Reference
|
|---|
| 77 | ; - C0PDFN: DFN, by Value
|
|---|
| 78 | ; - C0PDUZ: DUZ, By Value
|
|---|
| 79 | ; Output:
|
|---|
| 80 | ; - None
|
|---|
| 81 | N DRUGS S DRUGS=$$DRUG2^C0PLKUP(MEDTOADD("DrugID"))
|
|---|
| 82 | N ZR,ZII ; GPL NEED TO FIND A NON-ZERO MATCH
|
|---|
| 83 | F ZII=1:1:10 S ZR=$P(DRUGS,U,ZII) Q:ZR>0 ; $$DRUG2 RETURNS a^b^c FOR MATCHES
|
|---|
| 84 | S DRUGS=ZR ; WE WANT THE FIRST NON-ZERO MATCH
|
|---|
| 85 | I +DRUGS=0 DO QUIT
|
|---|
| 86 | . D SENDMSG(.MEDTOADD,C0PDFN)
|
|---|
| 87 | . D NFADD(.MEDTOADD,C0PDFN,C0PDUZ)
|
|---|
| 88 | . N ZT
|
|---|
| 89 | . S ZT="Error Mapping Drug: "_MEDTOADD("DrugName")_" ID: "_MEDTOADD("DrugID")
|
|---|
| 90 | . D MAPERR(.ZRTN,"DRUGS",ZT) ; CALL ERROR ROUTINE TO RECORD NO MATCH FOR DRUG
|
|---|
| 91 | N DRUG S DRUG=+DRUGS ; grab the first entry; as good as any for now
|
|---|
| 92 | N ORDIEN S ORDIEN=$$GET1^DIQ(50,DRUG,"PHARMACY ORDERABLE ITEM","I")
|
|---|
| 93 | N DOSAGE S DOSAGE=MEDTOADD("DosageNumberDescription")_" "_MEDTOADD("DosageForm")
|
|---|
| 94 | ; ****** ADDED BY GPL 10/5/10 TO ALWAYS CAPTURE FDB NAME IN SIG
|
|---|
| 95 | N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
|
|---|
| 96 | I MEDTXT="" S MEDTXT=MEDTOADD("DrugName") ; drug not found condition gpl
|
|---|
| 97 | S DOSAGE=MEDTXT_"| "_MEDTOADD("DosageNumberDescription")_" "_MEDTOADD("DosageForm") ; | delimiter added by gpl 2/5/2010
|
|---|
| 98 | ; ****** END MOD
|
|---|
| 99 | N ROUTE S ROUTE=MEDTOADD("Route")
|
|---|
| 100 | N SCHEDULE S SCHEDULE=MEDTOADD("DosageFrequencyDescription")
|
|---|
| 101 | I MEDTOADD("TakeAsNeeded")="Y" S SCHEDULE=SCHEDULE_" PRN" ; Vista stores PRN in schedule
|
|---|
| 102 | N START S START=$$FMDATE(MEDTOADD("PrescriptionDate"))
|
|---|
| 103 | N COMMENT
|
|---|
| 104 | S COMMENT(1)="Received from E-Rx Web Service" ;todo: move to dialog file
|
|---|
| 105 | S COMMENT(2)="Order Guid: "_$G(MEDTOADD("OrderGuid"))
|
|---|
| 106 | S COMMENT(3)="Physician Name: "_$G(MEDTOADD("PhysicianName"))
|
|---|
| 107 | S COMMENT(4)="Prescription Date: "_$G(MEDTOADD("PrescriptionDate"))
|
|---|
| 108 | S COMMENT(5)="Prescription Guid: "_$G(MEDTOADD("PrescriptionGuid"))
|
|---|
| 109 | S COMMENT(6)="Notes: "_$G(MEDTOADD("PrescriptionNotes"))
|
|---|
| 110 | ; add codes for Certification and Free Txt repair processing - gpl
|
|---|
| 111 | S COMMENT(7)=$$CODES^C0PLKUP(MEDTOADD("DrugID")) ;
|
|---|
| 112 | D FILE^C0PNVA(C0PDFN,ORDIEN,DRUG,DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,.COMMENT)
|
|---|
| 113 | QUIT
|
|---|
| 114 | MAPERR(ZRTN,ZTYP,ZTXT) ; ZTYP IS THE TYPE OF MAPPING ERROR
|
|---|
| 115 | ; (IE DRUGS OR ALLERGY)
|
|---|
| 116 | ; ZRTN IS PASSED BY REFERENCE AND IS THE ARRAY OF ERROR MESSAGES
|
|---|
| 117 | ; THIS ROUTINE ADDS THE ERROR MESSAGE TO THE END OF THE ARRAY
|
|---|
| 118 | ; ZTXT IS THE ERROR MESSAGE
|
|---|
| 119 | ;
|
|---|
| 120 | N ZI
|
|---|
| 121 | I $G(^TMP("C0PDEBUG"))="" Q ; ONLY SHOW MAPPING ERRORS ON DEBUG
|
|---|
| 122 | I '$D(ZRTN) S ZI=1
|
|---|
| 123 | E S ZI=$O(ZRTN(""),-1)+1 ;ONE PASSED THE END OF ZRTN
|
|---|
| 124 | S ZRTN(ZI)=ZTXT
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | FMDATE(C0PD) ; Public $$ - Get fileman date from dates formatted like 11/7/09 10:22:34 PM
|
|---|
| 128 | ; Input: Date like 11/7/09 10:22:34 PM
|
|---|
| 129 | ; Output: Timson date precise up to seconds
|
|---|
| 130 | S $E(C0PD,$F(C0PD," ")-1)="@" ; put @ b/n date and time for fm
|
|---|
| 131 | N %DT S %DT="TS" ; seconds are required
|
|---|
| 132 | N X,Y
|
|---|
| 133 | S X=C0PD D ^%DT
|
|---|
| 134 | I Y<0 D ^%ZTER ; Problem converting date... wake up programmer
|
|---|
| 135 | QUIT Y
|
|---|
| 136 | ;
|
|---|
| 137 | DUP(FDBDRUGID,CURRENTMEDS) ; Private $$ - Is Drug already documented for patient?
|
|---|
| 138 | ; Input:
|
|---|
| 139 | ; FDBDRUGID By Value
|
|---|
| 140 | ; CURRENTMEDS By Reference
|
|---|
| 141 | ; Output:
|
|---|
| 142 | ; "" if no duplicate
|
|---|
| 143 | ; CURRENTMEDS ien if duplicate
|
|---|
| 144 | N DRUGS S DRUGS=$$DRUG2^C0PLKUP(FDBDRUGID)
|
|---|
| 145 | ; add a check for the CODES in Comment(6) - to update if not there
|
|---|
| 146 | N C0PCODES S C0PCODES=$$CODES^C0PLKUP(FDBDRUGID)
|
|---|
| 147 | N I S I=""
|
|---|
| 148 | N FOUND S FOUND=0
|
|---|
| 149 | F Q:FOUND=1 S I=$O(CURRENTMEDS(I)) Q:I="" D ; loop through current meds
|
|---|
| 150 | . I '$D(CURRENTMEDS(I,"DRUG")) QUIT ; continue if no drug id
|
|---|
| 151 | . I $G(CURRENTMEDS(I,"COMMENTS",1))'["Received from E-Rx Web Service" Q ;
|
|---|
| 152 | . ; DON'T MATCH ON DRUGS THAT ARE NOT ERX
|
|---|
| 153 | . ; check for CODES in COMMENTS(6)
|
|---|
| 154 | . I $G(CURRENTMEDS(I,"COMMENTS",6))'=C0PCODES D ; add codes
|
|---|
| 155 | . . ;S ^PS(55,C0PDFN,"NVA",I,1,7,0)=C0PCODES ; right into the global
|
|---|
| 156 | . I $P(CURRENTMEDS(I,0),U,9)'["ACTIVE" QUIT ; quit if not active
|
|---|
| 157 | . I ("^"_DRUGS_"^")[("^"_CURRENTMEDS(I,"DRUG")_"^") S FOUND=1
|
|---|
| 158 | QUIT I ; entry if Found, "" if not found
|
|---|
| 159 | ;
|
|---|
| 160 | FREMAT(FDBDNAME,CURRENTMEDS,ZMED) ;MATCH A FREE TEXT DRUG EXTRINSIC
|
|---|
| 161 | ; THE DRUG ID HAS BEEN STORED IN THE COMMENT OF EACH ERX NONVA DRUG
|
|---|
| 162 | ; ZMED IS WHICH DRUG IN CURRENTMEDS WHICH IS PASSED BY REF
|
|---|
| 163 | ; FDBDNAME IS THE DRUG NAME AND IS PASSED BY VALUE ; GPL
|
|---|
| 164 | N I S I=""
|
|---|
| 165 | ; add a check for the CODES in Comment(6) - to update if not there
|
|---|
| 166 | N C0PCODES S C0PCODES=$$CODES^C0PLKUP(MEDTOADD("DrugID"))
|
|---|
| 167 | N FOUND S FOUND=0
|
|---|
| 168 | F Q:FOUND=1 S I=$O(CURRENTMEDS(I)) Q:I="" D ; loop through current meds
|
|---|
| 169 | . I $D(CURRENTMEDS(I,"DRUG")) QUIT ; SKIP OVER MAPPED DRUGS
|
|---|
| 170 | . I $P(CURRENTMEDS(I,0),U,9)'["ACTIVE" QUIT ; quit if not active
|
|---|
| 171 | . I FDBDNAME=$$DRUGNAM^C0PLKUP(.CURRENTMEDS,I) S FOUND=1
|
|---|
| 172 | I FOUND=1 D ;
|
|---|
| 173 | . S ZT="Drug Dup Found: "_MEDTOADD("DrugName")_" ID: "_MEDTOADD("DrugID")
|
|---|
| 174 | . ; check for CODES in COMMENTS(6)
|
|---|
| 175 | . I $G(CURRENTMEDS(I,"COMMENTS",6))'=C0PCODES D ; add codes
|
|---|
| 176 | . . ;S ^PS(55,C0PDFN,"NVA",I,1,7,0)=C0PCODES ; right into the global
|
|---|
| 177 | . D MAPERR(.ZRTN,"DRUGS",ZT) ; CALL ERROR ROUTINE TO RECORD NO MATCH FOR DRUG
|
|---|
| 178 | Q I ; entry if Found, "" if not found
|
|---|
| 179 | ;
|
|---|
| 180 | SENDMSG(MEDTOADD,C0PDFN) ; Private EP - Send Bulletin saying drug not found
|
|---|
| 181 | ; Input:
|
|---|
| 182 | ; - MEDTOADD: WS Med entry By Reference
|
|---|
| 183 | ; - C0PDFN: DFN by Value
|
|---|
| 184 | ; Output:
|
|---|
| 185 | ; - None
|
|---|
| 186 | ; info: tested 12/14/09
|
|---|
| 187 | ; todo: move this to a background call - it takes too long!
|
|---|
| 188 | N DUZ ; remove old value to make the postmaster the sender
|
|---|
| 189 | N XMDUZ S XMDUZ="E-Rx WebService" ; supposed sender
|
|---|
| 190 | N XMTEXT ; unused
|
|---|
| 191 | N XMY ; unused
|
|---|
| 192 | N XMBTMP ; unused
|
|---|
| 193 | N XMDF ; unused
|
|---|
| 194 | N XMDT ; unused - will send message now
|
|---|
| 195 | N XMYBLOB ; unused
|
|---|
| 196 | N XMB
|
|---|
| 197 | S XMB="C0P EXTERNAL DRUG NOT FOUND" ; bulletin name
|
|---|
| 198 | S (XMB(1),XMB(5))=$$GET1^DIQ(2,C0PDFN,"PRIMARY LONG ID") ; chart #
|
|---|
| 199 | S (XMB(2),XMB(3))=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID")) ; drug not matched
|
|---|
| 200 | S XMB(4)=$$GET1^DIQ(2,C0PDFN,.01) ; patient name
|
|---|
| 201 | D ^XMB
|
|---|
| 202 | QUIT
|
|---|
| 203 | ;
|
|---|
| 204 | NFADD(MEDTOADD,C0PDFN,C0PDUZ) ; Private Proc - Add free text med to VistA
|
|---|
| 205 | ; Input:
|
|---|
| 206 | ; - MEDTOADD: WebService Drug information, by Reference
|
|---|
| 207 | ; - C0PDFN: DFN, by Value
|
|---|
| 208 | ; - C0PDUZ: DUZ, By Value
|
|---|
| 209 | ; Output:
|
|---|
| 210 | ; - None
|
|---|
| 211 | ; info: tested 12/16/09
|
|---|
| 212 | ; Stores med along side dosage in dosage field as free text
|
|---|
| 213 | N ORDIEN S ORDIEN=$$FIND1^DIC(50.7,"","QX","FREE TXT DRUG","B") ; todo: change to a parameter
|
|---|
| 214 | N DOSAGE
|
|---|
| 215 | N MEDTXT S MEDTXT=$$FULLNAME^C0PLKUP(MEDTOADD("DrugID"))
|
|---|
| 216 | I MEDTXT="" S MEDTXT=MEDTOADD("DrugName") ; drug not found condition gpl
|
|---|
| 217 | S DOSAGE=MEDTXT_"| "_MEDTOADD("DosageNumberDescription")_" "_MEDTOADD("DosageForm") ; | delimiter added by gpl 2/5/2010
|
|---|
| 218 | N ROUTE S ROUTE=MEDTOADD("Route")
|
|---|
| 219 | N SCHEDULE S SCHEDULE=MEDTOADD("DosageFrequencyDescription")
|
|---|
| 220 | I MEDTOADD("TakeAsNeeded")="Y" S SCHEDULE=SCHEDULE_" PRN" ;
|
|---|
| 221 | N START S START=$$FMDATE(MEDTOADD("PrescriptionDate"))
|
|---|
| 222 | N COMMENT
|
|---|
| 223 | S COMMENT(1)="Received from E-Rx Web Service" ;todo: move to dialog file
|
|---|
| 224 | S COMMENT(2)="Order Guid: "_$G(MEDTOADD("OrderGuid"))
|
|---|
| 225 | S COMMENT(3)="Physician Name: "_$G(MEDTOADD("PhysicianName"))
|
|---|
| 226 | S COMMENT(4)="Prescription Date: "_$G(MEDTOADD("PrescriptionDate"))
|
|---|
| 227 | S COMMENT(5)="Prescription Guid: "_$G(MEDTOADD("PrescriptionGuid"))
|
|---|
| 228 | S COMMENT(6)="Notes: "_$G(MEDTOADD("PrescriptionNotes"))
|
|---|
| 229 | ; add codes for Certification and Free Txt repair processing - gpl
|
|---|
| 230 | S COMMENT(7)=$$CODES^C0PLKUP(MEDTOADD("DrugID")) ;
|
|---|
| 231 | D FILE^C0PNVA(C0PDFN,ORDIEN,"",DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,.COMMENT)
|
|---|
| 232 | ;N COMMENT ;added DrugID to comment 1/27/2010 gpl
|
|---|
| 233 | ;S COMMENT="Received from E-Rx Web Service (DrugID:"_MEDTOADD("DrugID")_")"
|
|---|
| 234 | ;D FILE^C0PNVA(C0PDFN,ORDIEN,"",DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,COMMENT)
|
|---|
| 235 | QUIT
|
|---|
