source: ccr/trunk/p/C0CMED.m@ 1546

Last change on this file since 1546 was 1544, checked in by Sam Habiel, 12 years ago

Merged Routines in OHUM branch back in main tree
  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CMED.m1290
    /ccr/branches/ohum/p/C0CMED.m1291-1543
    /ccr/branches/ohum/p/p/C0CMED.m1287-1289
File size: 4.8 KB
RevLine 
[1544]1C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
2 ;;1.2;C0C;;May 11, 2012;Build 47
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
27EXTRACT(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
55RPMS
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
72VISTA
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
Note: See TracBrowser for help on using the repository browser.