| 1 | C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
|
|---|
| 2 | ;;1.0;C0C;;May 19, 2009;
|
|---|
| 3 | ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
|
|---|
| 4 | ; Licensed under the terms of the GNU General Public License.
|
|---|
| 5 | ; 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 | ; --Revision History
|
|---|
| 22 | ; July 2008 - Initial Version/GPL
|
|---|
| 23 | ; July 2008 - March 2009 various revisions
|
|---|
| 24 | ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
|
|---|
| 25 | ;
|
|---|
| 26 | Q
|
|---|
| 27 | EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
|
|---|
| 28 | ; DFN passed by reference
|
|---|
| 29 | ; MEDXML and MEDOUTXML are passed by Name
|
|---|
| 30 | ; MEDXML is the input template
|
|---|
| 31 | ; MEDOUTXML is the output template
|
|---|
| 32 | ; Both of them refer to ^TMP globals where the XML documents are stored
|
|---|
| 33 | ;
|
|---|
| 34 | ; -- This ep is the driver for extracting medications into the provided XML template
|
|---|
| 35 | ; 1. VA Outpatient Meds are in C0CMED1
|
|---|
| 36 | ; 2. VA Pending Meds are in C0CMED2
|
|---|
| 37 | ; 3. VA non-VA Meds are in C0CMED3
|
|---|
| 38 | ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
|
|---|
| 39 | ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
|
|---|
| 40 | ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
|
|---|
| 41 | ;
|
|---|
| 42 | ; --Get parameters for meds
|
|---|
| 43 | S @MEDOUTXML@(0)=0 ; By default, empty.
|
|---|
| 44 | N C0CMFLAG
|
|---|
| 45 | S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
|
|---|
| 46 | W:$G(DEBUG) "Med Parameters: ",!
|
|---|
| 47 | W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
|
|---|
| 48 | W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
|
|---|
| 49 | W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
|
|---|
| 50 | W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
|
|---|
| 51 | ; --Find out what system we are on and branch out...
|
|---|
| 52 | W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
|
|---|
| 53 | I $$RPMS^C0CUTIL() D RPMS QUIT
|
|---|
| 54 | I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
|---|
| 55 | RPMS
|
|---|
| 56 | ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
|
|---|
| 57 | N MEDCOUNT S MEDCOUNT=0
|
|---|
| 58 | K ^TMP($J,"MED")
|
|---|
| 59 | N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
|---|
| 60 | N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
|
|---|
| 61 | S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
|
|---|
| 62 | D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
|
|---|
| 63 | D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
|---|
| 64 | I @HIST@(0)>0 D
|
|---|
| 65 | . D CP^C0CXPATH(HIST,MEDOUTXML)
|
|---|
| 66 | . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
|---|
| 67 | I @NVA@(0)>0 D
|
|---|
| 68 | . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
|---|
| 69 | . ;E D CP^C0CXPATH(NVA,MEDOUTXML)
|
|---|
| 70 | . W:$G(DEBUG) "HAS NON-VA MEDS",!
|
|---|
| 71 | Q
|
|---|
| 72 | VISTA
|
|---|
| 73 | N MEDCOUNT S MEDCOUNT=0
|
|---|
| 74 | K ^TMP($J,"MED")
|
|---|
| 75 | N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
|---|
| 76 | N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
|
|---|
| 77 | N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
|
|---|
| 78 | K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY
|
|---|
| 79 | S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
|
|---|
| 80 | ; N IPIV ; Inpatient IV Meds
|
|---|
| 81 | ; N IPUD ; Inpatient UD Meds
|
|---|
| 82 | D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
|
|---|
| 83 | D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
|
|---|
| 84 | ;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
|---|
| 85 | D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
|
|---|
| 86 | I @HIST@(0)>0 D
|
|---|
| 87 | . D CP^C0CXPATH(HIST,MEDOUTXML)
|
|---|
| 88 | . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
|---|
| 89 | I @PEND@(0)>0 D
|
|---|
| 90 | . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
|
|---|
| 91 | . E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
|
|---|
| 92 | . W:$G(DEBUG) "HAS OP PENDING MEDS",!
|
|---|
| 93 | I @NVA@(0)>0 D
|
|---|
| 94 | . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
|---|
| 95 | . E D CP^C0CXPATH(NVA,MEDOUTXML)
|
|---|
| 96 | . W:$G(DEBUG) "HAS NON-VA MEDS",!
|
|---|
| 97 | N ZI
|
|---|
| 98 | S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
|---|
| 99 | M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
|
|---|
| 100 | K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
|
|---|
| 101 | K @PEND
|
|---|
| 102 | K @HIST
|
|---|
| 103 | K @NVA
|
|---|
| 104 | Q
|
|---|
| 105 |
|
|---|
