Ignore:
Timestamp:
Jun 23, 2011, 3:01:41 PM (13 years ago)
Author:
George Lilly
Message:

updates for MU Certification

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CALERT.m

    r666 r1204  
    1 C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
    2  ;;1.0;C0C;;May 19, 2009;
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
    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(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO  XML TEMPLATE
    25  ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
    26  ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    27  ;
    28  ; GET ADVERSE REACTIONS AND ALLERGIES
    29  ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
    30  S GMRA="0^0^111"
    31  D EN1^GMRADPT
    32  I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
    33  . S @ALTOUTXML@(0)=0
    34  ; DEFINE MAPPING
    35  N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
    36  S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
    37  S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
    38  K @ALTTVMAP,@ALTTARYTMP
    39  N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
    40  S ALTTMP="" ;
    41  F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
    42  . W "ALTTMP="_ALTTMP,!
    43  . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
    44  . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
    45  . K @ALTVMAP
    46  . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
    47  . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
    48  . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
    49  . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
    50  . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
    51  . N ADT S ADT="Patient has an " ; X $ZINT H 5
    52  . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
    53  . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
    54  . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
    55  . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
    56  . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
    57  . N ALTCDE ; SNOMED CODE THE THE ALERT
    58  . S ALTCDE=$S(A2="P":"282100009",A2="A":"418634005",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
    59  . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
    60  . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
    61  . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
    62  . I ALTCDE'="" D  ; IF THERE IS A CODE
    63  . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
    64  . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
    65  . E  D  ; SET TO NULL
    66  . . S @ALTVMAP@("ALERTCODESYSTEM")=""
    67  . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
    68  . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
    69  . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
    70  . I ALTPROV'="" D  ; PROVIDER PROVIDEED
    71  . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
    72  . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
    73  . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
    74  . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
    75  . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
    76  . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
    77  . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
    78  . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
    79  . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
    80  . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
    81  . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
    82  . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
    83  . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
    84  . I ACVUID'="" D  ; IF VUID IS NOT NULL
    85  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
    86  . E  D  ; IF REACTANT CODE VALUE IS NULL
    87  . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
    88  . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
    89  . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
    90  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
    91  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
    92  . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
    93  . N ARTMP,ARIEN,ARDES,ARVUID
    94  . S (ARTMP,ARDES,ARVUID)=""
    95  . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
    96  . . S ARTMP=@ALTG@(ALTTMP,"S",1)
    97  . . W "REACTION:",ARTMP,!
    98  . . S ARIEN=$P(ARTMP,";",2)
    99  . . S ARDES=$P(ARTMP,";",1)
    100  . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
    101  . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
    102  . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
    103  . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
    104  . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
    105  . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
    106  . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
    107  . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
    108  . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
    109  . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
    110  . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
    111  . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
    112  . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
    113  . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
    114  . K @ALTARYTMP
    115  . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
    116  . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
    117  . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
    118  . S ALTCNT=ALTCNT+1
    119  S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
    120  Q
    121 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
    122  ; INGLB IS OF THE FORM: PSNDF(50.6,
    123  ; RETURN 50.6
    124  Q $P($P(INGLB,"(",2),",",1)  ;
     1C0CALERT         ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
     2        ;;1.0;C0C;;May 19, 2009;Build 38
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
     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        ;
     24EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK)    ; EXTRACT ALERTS INTO  XML TEMPLATE
     25        ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
     26        ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     27        ;
     28        ; GET ADVERSE REACTIONS AND ALLERGIES
     29        ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
     30        S GMRA="0^0^111"
     31        D EN1^GMRADPT
     32        I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
     33        . S @ALTOUTXML@(0)=0
     34        ; DEFINE MAPPING
     35        N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
     36        S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
     37        S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
     38        K @ALTTVMAP,@ALTTARYTMP
     39        N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
     40        S ALTTMP="" ;
     41        F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
     42        . W "ALTTMP="_ALTTMP,!
     43        . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
     44        . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
     45        . K @ALTVMAP
     46        . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
     47        . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
     48        . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
     49        . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
     50        . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
     51        . N ADT S ADT="Patient has an " ; X $ZINT H 5
     52        . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
     53        . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
     54        . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
     55        . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
     56        . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
     57        . N ALTCDE ; SNOMED CODE THE THE ALERT
     58        . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
     59        . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
     60        . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
     61        . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
     62        . I ALTCDE'="" D  ; IF THERE IS A CODE
     63        . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
     64        . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
     65        . E  D  ; SET TO NULL
     66        . . S @ALTVMAP@("ALERTCODESYSTEM")=""
     67        . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
     68        . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
     69        . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
     70        . I ALTPROV'="" D  ; PROVIDER PROVIDEED
     71        . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
     72        . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
     73        . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
     74        . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
     75        . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
     76        . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
     77        . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
     78        . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
     79        . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
     80        . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
     81        . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
     82        . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
     83        . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
     84        . I ACVUID'="" D  ; IF VUID IS NOT NULL
     85        . . S ZC=$$CODE^C0CUTIL(ACVUID)
     86        . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
     87        . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
     88        . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
     89        . E  D  ; IF REACTANT CODE VALUE IS NULL
     90        . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
     91        . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
     92        . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
     93        . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
     94        . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
     95        . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
     96        . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
     97        . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
     98        . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
     99        . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
     100        . N ARTMP,ARIEN,ARDES,ARVUID
     101        . S (ARTMP,ARDES,ARVUID)=""
     102        . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
     103        . . S ARTMP=@ALTG@(ALTTMP,"S",1)
     104        . . W "REACTION:",ARTMP,!
     105        . . S ARIEN=$P(ARTMP,";",2)
     106        . . S ARDES=$P(ARTMP,";",1)
     107        . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
     108        . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
     109        . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
     110        . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
     111        . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
     112        . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
     113        . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
     114        . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
     115        . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
     116        . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
     117        . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
     118        . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
     119        . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
     120        . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
     121        . K @ALTARYTMP
     122        . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
     123        . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
     124        . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
     125        . S ALTCNT=ALTCNT+1
     126        S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
     127        Q
     128PRSGLB(INGLB)   ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
     129        ; INGLB IS OF THE FORM: PSNDF(50.6,
     130        ; RETURN 50.6
     131        Q $P($P(INGLB,"(",2),",",1)  ;
Note: See TracChangeset for help on using the changeset viewer.