Ignore:
Timestamp:
May 11, 2012, 6:06:25 PM (13 years ago)
Author:
Sam Habiel
Message:

Update of all routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/branches/ohum/p/C0CMED.m

    r1342 r1428  
    1 C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
    2  ;;1.0;C0C;;May 19, 2009;Build 2
    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  
     1C0CMED  ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
     2        ;;1.2;C0C;;May 11, 2012;Build 46
     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 TracChangeset for help on using the changeset viewer.