From f86810d384d7c3a09e392b78bf9570fbd79671e6 Mon Sep 17 00:00:00 2001 From: sam Date: Mon, 23 Mar 2009 04:21:08 +0000 Subject: [PATCH] Refactoring C0CMED Updated C0CUTIL with checks on whether we are in RPMS, Vista, WorldVista, or OpenVista --- p/C0CMED.m | 277 +++++++++++++--------------------------------------- p/C0CUTIL.m | 6 +- 2 files changed, 74 insertions(+), 209 deletions(-) diff --git a/p/C0CMED.m b/p/C0CMED.m index a246a62..99ab6d5 100644 --- a/p/C0CMED.m +++ b/p/C0CMED.m @@ -1,208 +1,69 @@ -C0CMED ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08 14:33 - ;;0.1;CCDCCR;;JUL 16,2008; - ;Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. - ;Licensed under the terms of the GNU General Public License. - ;See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - W "NO ENTRY FROM TOP",! - Q - ; -EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE - ; - ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED - ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE - ; - N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS - N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED - ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^C0CMED1 - ; OUTPATIENT PENDING MEDS IN EXTRACT^C0CMED2 - ; NON-VA MEDS IN EXTRACT^C0CMED3 - ; INPATIENT MEDS IN EXTRACT^C0CMED4 - ; ALL OTHERS HERE - S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) - K @MEDTVMAP ; CLEAR VARIABLE ARRAY - S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED - S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP")) - K @MEDTARYTMP ; KILL XML ARRAY - I $G(DUZ("AG"))="I" D Q ; - . ; I '$D(C0CTESTMEDS) G USERPC ; DELETE THIS LINE AFTER TESTING IS DONE - . D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML) - . ; I @MEDOUTXML@(0)=0 D USERPC ; FOR RPMS, USE THE RPC FOR MEDS - D EXTRACT^C0CMED1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS - I @MEDOUTXML@(0)>0 D ; C0CMED FOUND ACTIVE OP MEDS - . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML - . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP - . W MEDCNT,! - . W "HAS ACTIVE OP MEDS",! - N PENDINGXML,MEDPENDING - S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY - D EXTRACT^C0CMED2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS - I @PENDINGXML@(0)>0 D ; C0CMED FOUND PENDING OP MEDS - . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML - . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS - . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE - . E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY - . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP - . ; W MEDCNT,! - . W "HAS OP PENDING MEDS",! - N PENDINGXML,MEDPENDING - S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY - D EXTRACT^C0CMED3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS - I @PENDINGXML@(0)>0 D ; C0CMED FOUND PENDING OP MEDS - . ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML - . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS - . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS - . E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY - . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP - . ; W MEDCNT,! - . W "HAS NON-VA MEDS",! -THEND ; - Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED - ; ONCE NON-VA AND IP MEDS WORK (C0CMED3 AND C0CMED4) -USERPC ; ENTRY POINT FOR RPMS - N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF - D ACTIVE^ORWPS(.MEDRSLT,DFN) - I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT - . I DEBUG W "MEDICATIONS RPC RETURNED NULL",! - . S @MEDOUTXML@(0)=0 - . Q - ; I DEBUG ZWR MEDRSLT - S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) - S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP")) - ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE - ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS - ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI - N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED - ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES - S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS - F ZJ=1:1 Q:'$D(MEDRSLT(ZJ)) D ; COUNT THE MEDS AND LINES - . I MEDRSLT(ZJ)?1"~".E D ; FOUND NEW MED - . . S ZI=ZI+1 ; INCREMENT MED COUNT - . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS - . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT - . E D ; FOR EVERY LINE NOT A FIRST LINE IN MED - . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED - . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY - ;ZWR ZA - ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS - F ZI=1:1:ZA(0) D ; FOR EACH MED - . I DEBUG W "ZI IS ",ZI,! - . ; W ZI," ",MEDCNT,! - . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT - . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED - . ;I $P(MEDPTMP,U,1)?1"~OP" Q ; SKIP OP ACTIVE AND PENDING - . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED - . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS - . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE - . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS - . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")="" - . E S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^C0CUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE - . S @MEDVMAP@("MEDISSUEDATE")="" - . S @MEDVMAP@("MEDLASTFILLDATETXT")="" - . S @MEDVMAP@("MEDLASTFILLDATE")="" - . S @MEDVMAP@("MEDRXNOTXT")="" - . S @MEDVMAP@("MEDRXNO")="" - . S @MEDVMAP@("MEDDETAILUNADORNED")="" - . S @MEDVMAP@("MEDCONCVALUE")="" - . S @MEDVMAP@("MEDCONCUNIT")="" - . S @MEDVMAP@("MEDDOSEINDICATOR")="" - . S @MEDVMAP@("MEDDELIVERYMETHOD")="" - . S @MEDVMAP@("MEDRATEVALUE")="" - . S @MEDVMAP@("MEDRATEUNIT")="" - . S @MEDVMAP@("MEDVEHICLETEXT")="" - . S @MEDVMAP@("MEDFREQUENCYUNIT")="" - . S @MEDVMAP@("MEDINTERVALVALUE")="" - . S @MEDVMAP@("MEDINTERVALUNIT")="" - . S @MEDVMAP@("MEDPRNFLAG")="" - . S @MEDVMAP@("MEDPROBLEMOBJECTID")="" - . S @MEDVMAP@("MEDPROBLEMTYPETXT")="" - . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")="" - . S @MEDVMAP@("MEDPROBLEMCODEVALUE")="" - . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")="" - . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")="" - . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")="" - . S @MEDVMAP@("MEDSTOPINDICATOR")="" - . S @MEDVMAP@("MEDDIRSEQ")="" - . S @MEDVMAP@("MEDMULDIRMOD")="" - . S @MEDVMAP@("MEDPTINSTRUCTIONS")="" - . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")="" - . S @MEDVMAP@("MEDDATETIMEAGE")="" - . S @MEDVMAP@("MEDDATETIMEAGEUNITS")="" - . S @MEDVMAP@("MEDTYPETEXT")="Medication" - . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC - . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1" - . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3) - . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE - . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="" - . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")="" - . I $P(MEDPTMP,U,1)?1"~OP" D ; IS OUTPATIENT, MIGHT HAVE CODE - . . I $P(MEDPTMP,"^",10)="ACTIVE" D ; ONLY ACTIVE MEDS HAVE CODES - . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT - . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS - . . . I DEBUG W "RXIEN=",RXIEN,! ; - . . . ;D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP - . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D ; IF SUCCESS - . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27) - . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC" - . S @MEDVMAP@("MEDBRANDNAMETEXT")="" - . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")="" - . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")="" - . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")="" - . S @MEDVMAP@("MEDSTRENGTHVALUE")="" - . S @MEDVMAP@("MEDSTRENGTHUNIT")="" - . S @MEDVMAP@("MEDFORMTEXT")="" - . S @MEDVMAP@("MEDQUANTITYVALUE")="" - . S @MEDVMAP@("MEDQUANTITYUNIT")="" - . S @MEDVMAP@("MEDRFNO")="" - . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED - . I ZK>1 D ; MORE THAN ONE LINE IN MED - . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2) - . I ZK>2 D ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS - . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE - . . F ZN=2:1:ZK-1 D ; REMAINING LINES IN EACH MED - . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D ; REMOVE THIS MARKUP - . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT - . . . E S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE - . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR - . S @MEDVMAP@("MEDDOSEVALUE")="" - . S @MEDVMAP@("MEDDOSEUNIT")="" - . S @MEDVMAP@("MEDFREQUENCYVALUE")="" - . S @MEDVMAP@("MEDDURATIONVALUE")="" - . S @MEDVMAP@("MEDDURATIONUNIT")="" - . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")="" - . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")="" - . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI)) - . K @MEDARYTMP - . D MAP^C0CXPATH(MEDXML,MEDVMAP,MEDARYTMP) - . I ZI=1&('HASOP) D ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE - . . ; W "FIRST ONE",! - . . D CP^C0CXPATH(MEDARYTMP,MEDOUTXML) - . E D ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML - . . D INSINNER^C0CXPATH(MEDOUTXML,MEDARYTMP) - N MEDTMP,MEDI - D MISSING^C0CXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS - I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ - . W "MEDICATION MISSING ",! - . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),! - Q - ; -DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING - ; EXAMPLE: $$DIGITS("13R") RETURNS 13 - N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS - S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS - Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS - ; +C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 + ;;0.5;CCDCCR;;JUL 16,2008; + ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel. + ; Licensed under the terms of the GNU General Public License. + ; See attached copy of the License. + ; + ; This program is free software; you can redistribute it and/or modify + ; it under the terms of the GNU General Public License as published by + ; the Free Software Foundation; either version 2 of the License, or + ; (at your option) any later version. + ; + ; This program is distributed in the hope that it will be useful, + ; but WITHOUT ANY WARRANTY; without even the implied warranty of + ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ; GNU General Public License for more details. + ; + ; You should have received a copy of the GNU General Public License along + ; with this program; if not, write to the Free Software Foundation, Inc., + ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + ; --Revision History + ; July 2008 - Initial Version/GPL + ; July 2008 - March 2009 various revisions + ; March 2009 - Reconstruction of routine as driver for other med routines/SMH + ; + Q +EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template + ; DFN passed by reference + ; MEDXML and MEDOUTXML are passed by Name + ; MEDXML is the input template + ; MEDOUTXML is the output template + ; Both of them refer to ^TMP globals where the XML documents are stored + ; + ; -- This ep is the driver for extracting medications into the provided XML template + ; 1. VA Outpatient Meds are in C0CMED1 + ; 2. VA Pending Meds are in C0CMED2 + ; 3. VA non-VA Meds are in C0CMED3 + ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional) + ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009 + ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time. + ; + ; --Prep variables + D:$$RPMS^C0CUTIL() RPMS QUIT + D:($$VISTA^C0CUTIL())!($$WV^C0CUTIL()) VISTA QUIT + D EXTRACT^C0CMED1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS + I @MEDOUTXML@(0)>0 D ; C0CMED FOUND ACTIVE OP MEDS + . W "HAS ACTIVE OP MEDS",! + N PENDINGXML + S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY + D EXTRACT^C0CMED2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS + I @PENDINGXML@(0)>0 D ; C0CMED FOUND PENDING OP MEDS + . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS + . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE + . E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY + . W "HAS OP PENDING MEDS",! + N PENDINGXML + S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY + D EXTRACT^C0CMED3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS + I @PENDINGXML@(0)>0 D ; C0CMED FOUND PENDING OP MEDS + . I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS + . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS + . E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY + . W:$G(DEBUG) "HAS NON-VA MEDS",! + Q + ; Extraction Sections +RPMS + D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML) QUIT +VISTA + diff --git a/p/C0CUTIL.m b/p/C0CUTIL.m index 36e03cf..a2078d5 100644 --- a/p/C0CUTIL.m +++ b/p/C0CUTIL.m @@ -122,5 +122,9 @@ DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL . W DASTMP,"=",DASNO,! ; PRINT IT OUT Q ; -RPMS ; Are we running on an RPMS system rather than Vista? +RPMS() ; Are we running on an RPMS system rather than Vista? Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service +VISTA() ; Are we running on Vanilla Vista? + Q $G(DUZ("AG"))="V" ; If User Agency is VA +WV() ; Are we running on Customized Vista (WV or OpenVista)? + Q $G(DUZ("AG"))="E"!($G(DUZ("AG"))="O") ; Codes for WV and Other.