Ignore:
Timestamp:
Sep 26, 2012, 1:00:27 PM (12 years ago)
Author:
Sam Habiel
Message:

Updated routines per the KIDS build

File:
1 edited

Legend:

Unmodified
Added
Removed
  • smart/trunk/p/C0SMED.m

    r1526 r1540  
    1 C0SMED   ; GPL - Smart Meds Processing ;2/22/12  17:05
    2  ;;0.1;C0S;nopatch;noreleasedate;Build 2
    3  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
    4  ;General Public License See attached copy of the License.
    5  ;
    6  ;This program is free software; you can redistribute it and/or modify
    7  ;it under the terms of the GNU General Public License as published by
    8  ;the Free Software Foundation; either version 2 of the License, or
    9  ;(at your option) any later version.
    10  ;
    11  ;This program is distributed in the hope that it will be useful,
    12  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    13  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    14  ;GNU General Public License for more details.
    15  ;
    16  ;You should have received a copy of the GNU General Public License along
    17  ;with this program; if not, write to the Free Software Foundation, Inc.,
    18  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    19  ;
    20  Q
    21  ;
    22 MED(GRTN,C0SARY) ; GRTN, passed by reference,
    23  ; is the return name of the graph created. "" if none
    24  ; C0SARY is passed in by reference and is the NHIN array of meds
    25  ;
    26  I $O(C0SARY("med",""))="" D  Q  ;
    27  . I $D(DEBUG) W !,"No Meds"
    28  S GRTN="" ; default to no meds
    29  N C0SGRF
    30  S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP
    31  I $D(DEBUG) W !,"Processing ",C0SGRF
    32  D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
    33  N MEDTRP ; MEDS TRIPLES
    34  D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
    35  N FARY S FARY="C0XFARY"
    36  D USEFARY^C0XF2N(FARY)
    37  D VOCINIT^C0XUTIL
    38  ;
    39  N DUPCHK S DUPCHK="" ; check for no duplicates
    40  N ZI S ZI=""
    41  F  S ZI=$O(C0SARY("med",ZI)) Q:ZI=""  D  ;
    42  . N SDATE,SDTMP
    43  . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D  Q  ;
    44  . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
    45  . I $G(COSARY("med",ZI,"vaType@value"))="I" D  Q  ;
    46  . . I $D(DEBUG) W !,"Inpatient Med, skipping"
    47  . I $G(COSARY("med",ZI,"vaType@value"))="V" D  Q  ;
    48  . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
    49  . ;
    50  . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))
    51  . I SDTMP="" D  ;
    52  . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))
    53  . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date
    54  . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens
    55  . I SDATE="" S SDATE="UNKNOWN"
    56  . N DNAME,VUID,DCODE,RXNORM,SIG
    57  . S DNAME=$G(C0SARY("med",ZI,"name@value"))
    58  . I DNAME="" D  ;
    59  . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))
    60  . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))
    61  . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))
    62  . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))
    63  . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code
    64  . I $P(RXNORM,"^",2)="RXNORM" D  ;
    65  . . S RXVER=$P(RXNORM,"^",3)
    66  . . S RXNORM=$P(RXNORM,"^",1)
    67  . E  D  Q  ;
    68  . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"
    69  . . I $D(DEBUG) W !,RXNORM
    70  . I DNAME="" D  Q  ;
    71  . . I $D(DEBUG) W !,"Error No Drug Name"
    72  . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)
    73  . I +$D(DUPCHK(MEDGRF)) D  Q  ; NO DUPS ALLOWED
    74  . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF
    75  . S DUPCHK(MEDGRF)=""
    76  . I $D(DEBUG) D  ;
    77  . . W !,"Processing Medication ",MEDGRF
    78  . . W !,DNAME
    79  . . W !,RXNORM
    80  . S SIG=$G(C0SARY("med",ZI,"sig"))
    81  . I SIG["|" D  ;
    82  . . N SIGTMP
    83  . . S SIGTMP=SIG
    84  . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig
    85  . . I DNAME["FREE TXT" D  ; eRx free text drug, get drug name from sig
    86  . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig
    87  . K C0XFARY
    88  . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)
    89  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)
    90  . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject
    91  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)
    92  . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)
    93  . N NQTY,NQTY2,NFREQ,NFREQ2
    94  . S NQTY=$$ANONS^C0XF2N ; anonomous subject
    95  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)
    96  . S NQTY2=$$ANONS^C0XF2N ; anonomous subject
    97  . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)
    98  . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))
    99  . I DOSE="" S DOSE="UNKNOWN"
    100  . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))
    101  . I UNIT="" S UNIT="UNKNOWN"
    102  . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)
    103  . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)
    104  . S NFREQ=$$ANONS^C0XF2N ; anonomous subject
    105  . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject
    106  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)
    107  . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)
    108  . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))
    109  . I SCHED="" S SCHED="UNKNOWN"
    110  . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))
    111  . I SCHUNIT="" S SCHUNIT="UNKNOWN"
    112  . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)
    113  . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)
    114  . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)
    115  . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)
    116  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)
    117  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)
    118  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)
    119  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)
    120  . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)
    121  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)
    122  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)
    123  . D BULKLOAD^C0XF2N(.C0XFDA)
    124  . K C0XFDA
    125  S GRTN=C0SGRF
    126  q
    127  ;
    128 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
    129  ;
    130 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
    131  ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
    132  N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
    133  I $G(ZVUID)="" Q ""
    134  I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
    135  N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
    136  S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
    137  N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
    138  S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
    139  I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
    140  Q ZRSLT
    141  ;
    142 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
    143  ; CONFORM TO NIST REQUIREMENTS
    144  ;INPATIENT CERTIFICATION
    145  I ZRXN=309362 S ZRXN=213169
    146  I ZRXN=855318 S ZRXN=855320
    147  I ZRXN=197361 S ZRXN=212549
    148  ;OUTPATIENT CERTIFICATION
    149  I ZRXN=310534 S ZRXN=205875
    150  I ZRXN=617312 S ZRXN=617314
    151  I ZRXN=310429 S ZRXN=200801
    152  I ZRXN=628953 S ZRXN=628958
    153  I ZRXN=745679 S ZRXN=630208
    154  I ZRXN=311564 S ZRXN=979334
    155  I ZRXN=836343 S ZRXN=836370
    156  Q ZRXN
    157  ;
     1C0SMED    ; GPL - Smart Meds Processing ;2/22/12  17:05
     2        ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2
     3        ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     4        ;General Public License See attached copy of the License.
     5        ;
     6        ;This program is free software; you can redistribute it and/or modify
     7        ;it under the terms of the GNU General Public License as published by
     8        ;the Free Software Foundation; either version 2 of the License, or
     9        ;(at your option) any later version.
     10        ;
     11        ;This program is distributed in the hope that it will be useful,
     12        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     13        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14        ;GNU General Public License for more details.
     15        ;
     16        ;You should have received a copy of the GNU General Public License along
     17        ;with this program; if not, write to the Free Software Foundation, Inc.,
     18        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     19        ;
     20        Q
     21        ;
     22MED(GRTN,C0SARY)        ; GRTN, passed by reference,
     23        ; is the return name of the graph created. "" if none
     24        ; C0SARY is passed in by reference and is the NHIN array of meds
     25        ;
     26        I $O(C0SARY("med",""))="" D  Q  ;
     27        . I $D(DEBUG) W !,"No Meds"
     28        S GRTN="" ; default to no meds
     29        N C0SGRF
     30        S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP
     31        I $D(DEBUG) W !,"Processing ",C0SGRF
     32        D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
     33        N MEDTRP ; MEDS TRIPLES
     34        D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
     35        N FARY S FARY="C0XFARY"
     36        D USEFARY^C0XF2N(FARY)
     37        D VOCINIT^C0XUTIL
     38        ;
     39        N DUPCHK S DUPCHK="" ; check for no duplicates
     40        N ZI S ZI=""
     41        F  S ZI=$O(C0SARY("med",ZI)) Q:ZI=""  D  ;
     42        . N SDATE,SDTMP
     43        . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D  Q  ;
     44        . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
     45        . I $G(COSARY("med",ZI,"vaType@value"))="I" D  Q  ;
     46        . . I $D(DEBUG) W !,"Inpatient Med, skipping"
     47        . I $G(COSARY("med",ZI,"vaType@value"))="V" D  Q  ;
     48        . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
     49        . ;
     50        . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))
     51        . I SDTMP="" D  ;
     52        . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))
     53        . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date
     54        . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens
     55        . I SDATE="" S SDATE="UNKNOWN"
     56        . N DNAME,VUID,DCODE,RXNORM,SIG
     57        . S DNAME=$G(C0SARY("med",ZI,"name@value"))
     58        . I DNAME="" D  ;
     59        . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))
     60        . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))
     61        . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))
     62        . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))
     63        . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code
     64        . I $P(RXNORM,"^",2)="RXNORM" D  ;
     65        . . S RXVER=$P(RXNORM,"^",3)
     66        . . S RXNORM=$P(RXNORM,"^",1)
     67        . E  D  Q  ;
     68        . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"
     69        . . I $D(DEBUG) W !,RXNORM
     70        . I DNAME="" D  Q  ;
     71        . . I $D(DEBUG) W !,"Error No Drug Name"
     72        . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)
     73        . I +$D(DUPCHK(MEDGRF)) D  Q  ; NO DUPS ALLOWED
     74        . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF
     75        . S DUPCHK(MEDGRF)=""
     76        . I $D(DEBUG) D  ;
     77        . . W !,"Processing Medication ",MEDGRF
     78        . . W !,DNAME
     79        . . W !,RXNORM
     80        . S SIG=$G(C0SARY("med",ZI,"sig"))
     81        . I SIG["|" D  ;
     82        . . N SIGTMP
     83        . . S SIGTMP=SIG
     84        . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig
     85        . . I DNAME["FREE TXT" D  ; eRx free text drug, get drug name from sig
     86        . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig
     87        . K C0XFARY
     88        . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)
     89        . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)
     90        . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject
     91        . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)
     92        . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)
     93        . N NQTY,NQTY2,NFREQ,NFREQ2
     94        . S NQTY=$$ANONS^C0XF2N ; anonomous subject
     95        . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)
     96        . S NQTY2=$$ANONS^C0XF2N ; anonomous subject
     97        . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)
     98        . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))
     99        . I DOSE="" S DOSE="UNKNOWN"
     100        . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))
     101        . I UNIT="" S UNIT="UNKNOWN"
     102        . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)
     103        . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)
     104        . S NFREQ=$$ANONS^C0XF2N ; anonomous subject
     105        . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject
     106        . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)
     107        . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)
     108        . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))
     109        . I SCHED="" S SCHED="UNKNOWN"
     110        . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))
     111        . I SCHUNIT="" S SCHUNIT="UNKNOWN"
     112        . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)
     113        . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)
     114        . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)
     115        . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)
     116        . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)
     117        . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)
     118        . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)
     119        . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)
     120        . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)
     121        . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)
     122        . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)
     123        . D BULKLOAD^C0XF2N(.C0XFDA)
     124        . K C0XFDA
     125        S GRTN=C0SGRF
     126        q
     127        ;
     128RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
     129        ;
     130RXCUI(ZVUID)    ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
     131        ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
     132        N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
     133        I $G(ZVUID)="" Q ""
     134        I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
     135        N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
     136        S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
     137        N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
     138        S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
     139        I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
     140        Q ZRSLT
     141        ;
     142NISTMAP(ZRXN)   ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
     143        ; CONFORM TO NIST REQUIREMENTS
     144        ;INPATIENT CERTIFICATION
     145        I ZRXN=309362 S ZRXN=213169
     146        I ZRXN=855318 S ZRXN=855320
     147        I ZRXN=197361 S ZRXN=212549
     148        ;OUTPATIENT CERTIFICATION
     149        I ZRXN=310534 S ZRXN=205875
     150        I ZRXN=617312 S ZRXN=617314
     151        I ZRXN=310429 S ZRXN=200801
     152        I ZRXN=628953 S ZRXN=628958
     153        I ZRXN=745679 S ZRXN=630208
     154        I ZRXN=311564 S ZRXN=979334
     155        I ZRXN=836343 S ZRXN=836370
     156        Q ZRXN
     157        ;
Note: See TracChangeset for help on using the changeset viewer.