| 1 | C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
 | 
|---|
| 2 |  ;;1.0;C0C;;May 19, 2009;Build 38
 | 
|---|
| 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 S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds
 | 
|---|
| 82 |  K @IPUD
 | 
|---|
| 83 |  S @IPUD@(0)=0
 | 
|---|
| 84 |  ;
 | 
|---|
| 85 |  D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
 | 
|---|
| 86 |  D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
 | 
|---|
| 87 |  ;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
 | 
|---|
| 88 |  D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
 | 
|---|
| 89 |  D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
 | 
|---|
| 90 |  I @HIST@(0)>0 D  
 | 
|---|
| 91 |  . D CP^C0CXPATH(HIST,MEDOUTXML)
 | 
|---|
| 92 |  . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
 | 
|---|
| 93 |  I @PEND@(0)>0 D  
 | 
|---|
| 94 |  . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
 | 
|---|
| 95 |  . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
 | 
|---|
| 96 |  . W:$G(DEBUG) "HAS OP PENDING MEDS",!
 | 
|---|
| 97 |  I @NVA@(0)>0 D 
 | 
|---|
| 98 |  . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
 | 
|---|
| 99 |  . E  D CP^C0CXPATH(NVA,MEDOUTXML) 
 | 
|---|
| 100 |  . W:$G(DEBUG) "HAS NON-VA MEDS",!
 | 
|---|
| 101 |  I @IPUD@(0)>0 D 
 | 
|---|
| 102 |  . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 
 | 
|---|
| 103 |  . E  D CP^C0CXPATH(IPUD,MEDOUTXML) 
 | 
|---|
| 104 |  . W:$G(DEBUG) "HAS INPATIENT MEDS",!
 | 
|---|
| 105 |  N ZI
 | 
|---|
| 106 |  S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
 | 
|---|
| 107 |  M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
 | 
|---|
| 108 |  K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
 | 
|---|
| 109 |  K @PEND
 | 
|---|
| 110 |  K @HIST
 | 
|---|
| 111 |  K @NVA
 | 
|---|
| 112 |  K @IPUD
 | 
|---|
| 113 |  Q
 | 
|---|
| 114 |  
 | 
|---|