Changeset 418 for ccr/trunk/p


Ignore:
Timestamp:
Mar 23, 2009, 12:21:08 AM (16 years ago)
Author:
Sam Habiel
Message:

Refactoring C0CMED
Updated C0CUTIL with checks on whether we are in RPMS, Vista, WorldVista, or OpenVista

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p/C0CMED.m

    r416 r418  
    1 C0CMED ; CCDCCR/GPL - CCR/CCD PROCESSING FOR MEDICATIONS ;07/23/08  14:33
    2  ;;0.1;CCDCCR;;JUL 16,2008;
    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  W "NO ENTRY FROM TOP",!
    22  Q
    23  ;
    24 EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
    25  ;
    26  ; MEDXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    27  ; IMEDXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
    28  ;
    29  N HASOP S HASOP=0 ; FLAG FOR HAS OUTPATIENT MEDS
    30  N MEDCNT S MEDCNT=0 ; COUNT FOR MEDS ALREADY PROCESSED
    31  ; OUTPATIENT ACTIVE MEDS ARE PROCESSED IN EXTRACT^C0CMED1
    32  ; OUTPATIENT PENDING MEDS IN EXTRACT^C0CMED2
    33  ; NON-VA MEDS IN EXTRACT^C0CMED3
    34  ; INPATIENT MEDS IN EXTRACT^C0CMED4
    35  ; ALL OTHERS HERE
    36  S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
    37  K @MEDTVMAP ; CLEAR VARIABLE ARRAY
    38  S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
    39  S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP"))
    40  K @MEDTARYTMP ; KILL XML ARRAY
    41  I $G(DUZ("AG"))="I" D  Q  ;
    42  . ; I '$D(C0CTESTMEDS) G USERPC ; DELETE THIS LINE AFTER TESTING IS DONE
    43  . D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML)
    44  . ; I @MEDOUTXML@(0)=0 D USERPC ; FOR RPMS, USE THE RPC FOR MEDS
    45  D EXTRACT^C0CMED1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
    46  I @MEDOUTXML@(0)>0 D  ; C0CMED FOUND ACTIVE OP MEDS
    47  . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
    48  . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
    49  . W MEDCNT,!
    50  . W "HAS ACTIVE OP MEDS",!
    51  N PENDINGXML,MEDPENDING
    52  S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
    53  D EXTRACT^C0CMED2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
    54  I @PENDINGXML@(0)>0 D  ; C0CMED FOUND PENDING OP MEDS
    55  . S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
    56  . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
    57  . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
    58  . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
    59  . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
    60  . ; W MEDCNT,!
    61  . W "HAS OP PENDING MEDS",!
    62  N PENDINGXML,MEDPENDING
    63  S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
    64  D EXTRACT^C0CMED3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
    65  I @PENDINGXML@(0)>0 D  ; C0CMED FOUND PENDING OP MEDS
    66  . ; S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
    67  . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
    68  . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
    69  . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
    70  . S MEDCNT=MEDCNT+@MEDTVMAP@(0) ; SAVE COUNT TO KNOW HOW TO ADD TO MAP
    71  . ; W MEDCNT,!
    72  . W "HAS NON-VA MEDS",!
    73 THEND ;
    74  Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED
    75  ; ONCE NON-VA AND IP MEDS WORK (C0CMED3 AND C0CMED4)
    76 USERPC ; ENTRY POINT FOR RPMS
    77  N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
    78  D ACTIVE^ORWPS(.MEDRSLT,DFN)
    79  I '$D(MEDRSLT(1)) D  ; NO MEDS FOR THIS PATIENT, EXIT
    80  . I DEBUG W "MEDICATIONS RPC RETURNED NULL",!
    81  . S @MEDOUTXML@(0)=0
    82  . Q
    83  ; I DEBUG ZWR MEDRSLT
    84  S MEDTVMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
    85  S MEDTARYTMP=$NA(^TMP("C0CCCR",$J,"MEDARYTMP"))
    86  ; I 'HASOP K @MEDTVMAP,@MEDTARYTMP KILL MOVED TO TOP OF ROUTINE
    87  ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS
    88  ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI
    89  N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED
    90  ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES
    91  S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS
    92  F ZJ=1:1 Q:'$D(MEDRSLT(ZJ))  D  ; COUNT THE MEDS AND LINES
    93  . I MEDRSLT(ZJ)?1"~".E D  ; FOUND NEW MED
    94  . . S ZI=ZI+1 ; INCREMENT MED COUNT
    95  . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS
    96  . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT
    97  . E  D  ; FOR EVERY LINE NOT A FIRST LINE IN MED
    98  . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED
    99  . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY
    100  ;ZWR ZA
    101  ; S @MEDTVMAP@(0)=ZA(0) ; SAVE NUMBER OF MEDS
    102  F ZI=1:1:ZA(0) D  ; FOR EACH MED
    103  . I DEBUG W "ZI IS ",ZI,!
    104  . ; W ZI," ",MEDCNT,!
    105  . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
    106  . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
    107  . ;I $P(MEDPTMP,U,1)?1"~OP" Q  ; SKIP OP ACTIVE AND PENDING
    108  . S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
    109  . S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
    110  . S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
    111  . S @MEDVMAP@("MEDOBJECTID")="MED"_(MEDCNT) ; UNIQUE OBJID FOR MEDS
    112  . I $P(MEDPTMP,"^",11)="" S @MEDVMAP@("MEDISSUEDATETXT")=""
    113  . E  S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^C0CUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE
    114  . S @MEDVMAP@("MEDISSUEDATE")=""
    115  . S @MEDVMAP@("MEDLASTFILLDATETXT")=""
    116  . S @MEDVMAP@("MEDLASTFILLDATE")=""
    117  . S @MEDVMAP@("MEDRXNOTXT")=""
    118  . S @MEDVMAP@("MEDRXNO")=""
    119  . S @MEDVMAP@("MEDDETAILUNADORNED")=""
    120  . S @MEDVMAP@("MEDCONCVALUE")=""
    121  . S @MEDVMAP@("MEDCONCUNIT")=""
    122  . S @MEDVMAP@("MEDDOSEINDICATOR")=""
    123  . S @MEDVMAP@("MEDDELIVERYMETHOD")=""
    124  . S @MEDVMAP@("MEDRATEVALUE")=""
    125  . S @MEDVMAP@("MEDRATEUNIT")=""
    126  . S @MEDVMAP@("MEDVEHICLETEXT")=""
    127  . S @MEDVMAP@("MEDFREQUENCYUNIT")=""
    128  . S @MEDVMAP@("MEDINTERVALVALUE")=""
    129  . S @MEDVMAP@("MEDINTERVALUNIT")=""
    130  . S @MEDVMAP@("MEDPRNFLAG")=""
    131  . S @MEDVMAP@("MEDPROBLEMOBJECTID")=""
    132  . S @MEDVMAP@("MEDPROBLEMTYPETXT")=""
    133  . S @MEDVMAP@("MEDPROBLEMDESCRIPTION")=""
    134  . S @MEDVMAP@("MEDPROBLEMCODEVALUE")=""
    135  . S @MEDVMAP@("MEDPROBLEMCODINGSYSTEM")=""
    136  . S @MEDVMAP@("MEDPROBLEMCODINGVERSION")=""
    137  . S @MEDVMAP@("MEDPROBLEMSOURCEACTORID")=""
    138  . S @MEDVMAP@("MEDSTOPINDICATOR")=""
    139  . S @MEDVMAP@("MEDDIRSEQ")=""
    140  . S @MEDVMAP@("MEDMULDIRMOD")=""
    141  . S @MEDVMAP@("MEDPTINSTRUCTIONS")=""
    142  . S @MEDVMAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
    143  . S @MEDVMAP@("MEDDATETIMEAGE")=""
    144  . S @MEDVMAP@("MEDDATETIMEAGEUNITS")=""
    145  . S @MEDVMAP@("MEDTYPETEXT")="Medication"
    146  . S @MEDVMAP@("MEDSTATUSTEXT")=$P(MEDPTMP,"^",10) ; STATUS FROM RPC
    147  . S @MEDVMAP@("MEDSOURCEACTORID")="ACTORSYSTEM_1"
    148  . S @MEDVMAP@("MEDPRODUCTNAMETEXT")=$P(MEDPTMP,"^",3)
    149  . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")="" ; DEFAULT VALUE
    150  . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
    151  . S @MEDVMAP@("MEDPRODUCTNAMECODEVERSION")=""
    152  . I $P(MEDPTMP,U,1)?1"~OP" D  ; IS OUTPATIENT, MIGHT HAVE CODE
    153  . . I $P(MEDPTMP,"^",10)="ACTIVE" D  ; ONLY ACTIVE MEDS HAVE CODES
    154  . . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
    155  . . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
    156  . . . I DEBUG W "RXIEN=",RXIEN,! ;
    157  . . . ;D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
    158  . . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D  ; IF SUCCESS
    159  . . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
    160  . . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"
    161  . S @MEDVMAP@("MEDBRANDNAMETEXT")=""
    162  . S @MEDVMAP@("MEDBRANDNAMECODEVALUE")=""
    163  . S @MEDVMAP@("MEDBRANDNAMECODINGSYSTEM")=""
    164  . S @MEDVMAP@("MEDBRANDNAMECODEVERSION")=""
    165  . S @MEDVMAP@("MEDSTRENGTHVALUE")=""
    166  . S @MEDVMAP@("MEDSTRENGTHUNIT")=""
    167  . S @MEDVMAP@("MEDFORMTEXT")=""
    168  . S @MEDVMAP@("MEDQUANTITYVALUE")=""
    169  . S @MEDVMAP@("MEDQUANTITYUNIT")=""
    170  . S @MEDVMAP@("MEDRFNO")=""
    171  . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED
    172  . I ZK>1 D  ; MORE THAN ONE LINE IN MED
    173  . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2)
    174  . I ZK>2 D  ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS
    175  . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE
    176  . . F ZN=2:1:ZK-1 D  ; REMAINING LINES IN EACH MED
    177  . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D  ; REMOVE THIS MARKUP
    178  . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT
    179  . . . E  S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE
    180  . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR
    181  . S @MEDVMAP@("MEDDOSEVALUE")=""
    182  . S @MEDVMAP@("MEDDOSEUNIT")=""
    183  . S @MEDVMAP@("MEDFREQUENCYVALUE")=""
    184  . S @MEDVMAP@("MEDDURATIONVALUE")=""
    185  . S @MEDVMAP@("MEDDURATIONUNIT")=""
    186  . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")=""
    187  . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")=""
    188  . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI))
    189  . K @MEDARYTMP
    190  . D MAP^C0CXPATH(MEDXML,MEDVMAP,MEDARYTMP)
    191  . I ZI=1&('HASOP) D  ; FIRST ONE IS JUST A COPY MAKE SURE OP IS NOT THERE
    192  . . ; W "FIRST ONE",!
    193  . . D CP^C0CXPATH(MEDARYTMP,MEDOUTXML)
    194  . E  D  ; AFTER THE FIRST OR IF THERE ARE OP, INSERT INNER XML
    195  . . D INSINNER^C0CXPATH(MEDOUTXML,MEDARYTMP)
    196  N MEDTMP,MEDI
    197  D MISSING^C0CXPATH(MEDOUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
    198  I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
    199  . W "MEDICATION MISSING ",!
    200  . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
    201  Q
    202  ;
    203 DIGITS(INSTR) ; RETURN JUST THE LEADING DIGITS OF THE STRING
    204  ; EXAMPLE: $$DIGITS("13R") RETURNS 13
    205  N ALPHA ; CONTANT TO HOLD ALL ALPHA CHARACTERS
    206  S ALPHA="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ; ALPHAS
    207  Q $TR(INSTR,ALPHA) ; LEAVE ONLY THE DIGITS
    208  ;
     1C0CMED  ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
     2        ;;0.5;CCDCCR;;JUL 16,2008;
     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        ; --Prep variables     
     43        D:$$RPMS^C0CUTIL() RPMS QUIT
     44        D:($$VISTA^C0CUTIL())!($$WV^C0CUTIL()) VISTA QUIT
     45        D EXTRACT^C0CMED1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
     46        I @MEDOUTXML@(0)>0 D  ; C0CMED FOUND ACTIVE OP MEDS
     47        . W "HAS ACTIVE OP MEDS",!
     48        N PENDINGXML
     49        S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
     50        D EXTRACT^C0CMED2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
     51        I @PENDINGXML@(0)>0 D  ; C0CMED FOUND PENDING OP MEDS
     52        . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
     53        . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
     54        . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
     55        . W "HAS OP PENDING MEDS",!
     56        N PENDINGXML
     57        S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
     58        D EXTRACT^C0CMED3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
     59        I @PENDINGXML@(0)>0 D  ; C0CMED FOUND PENDING OP MEDS
     60        . I @MEDOUTXML@(0)>0 D  ; IF WE NEED TO COMBINE MEDS
     61        . . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
     62        . E  D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
     63        . W:$G(DEBUG) "HAS NON-VA MEDS",!
     64        Q
     65        ; Extraction Sections
     66RPMS
     67        D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML) QUIT
     68VISTA
     69       

  • ccr/trunk/p/C0CUTIL.m

    r411 r418  
    123123 Q
    124124 ;
    125 RPMS ; Are we running on an RPMS system rather than Vista?
     125RPMS() ; Are we running on an RPMS system rather than Vista?
    126126 Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
     127VISTA() ; Are we running on Vanilla Vista?
     128 Q $G(DUZ("AG"))="V" ; If User Agency is VA
     129WV() ; Are we running on Customized Vista (WV or OpenVista)?
     130 Q $G(DUZ("AG"))="E"!($G(DUZ("AG"))="O") ; Codes for WV and Other.
Note: See TracChangeset for help on using the changeset viewer.