Ignore:
Timestamp:
Jan 4, 2012, 9:39:08 PM (13 years ago)
Author:
George Lilly
Message:

removed tabs

File:
1 edited

Legend:

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

    r1331 r1336  
    1 C0CALERT        ; 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         ;
    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":"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         . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
    85         . I ACVUID'="" D  ; IF VUID IS NOT NULL
    86         . . S ZC=$$CODE^C0CUTIL(ACVUID)
    87         . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
    88         . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
    89         . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
    90         . E  D  ; IF REACTANT CODE VALUE IS NULL
    91         . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
    92         . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
    93         . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
    94         . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
    95         . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
    96         . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
    97         . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
    98         . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
    99         . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
    100         . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
    101         . N ARTMP,ARIEN,ARDES,ARVUID
    102         . S (ARTMP,ARDES,ARVUID)=""
    103         . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
    104         . . S ARTMP=@ALTG@(ALTTMP,"S",1)
    105         . . W "REACTION:",ARTMP,!
    106         . . S ARIEN=$P(ARTMP,";",2)
    107         . . S ARDES=$P(ARTMP,";",1)
    108         . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
    109         . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
    110         . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
    111         . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
    112         . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
    113         . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
    114         . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
    115         . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
    116         . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
    117         . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
    118         . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
    119         . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
    120         . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
    121         . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
    122         . K @ALTARYTMP
    123         . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
    124         . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
    125         . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
    126         . S ALTCNT=ALTCNT+1
    127         S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
    128         Q
    129 PRSGLB(INGLB)   ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
    130         ; INGLB IS OF THE FORM: PSNDF(50.6,
    131         ; RETURN 50.6
    132         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 . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
     85 . I ACVUID'="" D  ; IF VUID IS NOT NULL
     86 . . S ZC=$$CODE^C0CUTIL(ACVUID)
     87 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
     88 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
     89 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
     90 . E  D  ; IF REACTANT CODE VALUE IS NULL
     91 . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
     92 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
     93 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
     94 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
     95 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
     96 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
     97 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
     98 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
     99 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
     100 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
     101 . N ARTMP,ARIEN,ARDES,ARVUID
     102 . S (ARTMP,ARDES,ARVUID)=""
     103 . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
     104 . . S ARTMP=@ALTG@(ALTTMP,"S",1)
     105 . . W "REACTION:",ARTMP,!
     106 . . S ARIEN=$P(ARTMP,";",2)
     107 . . S ARDES=$P(ARTMP,";",1)
     108 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
     109 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
     110 . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
     111 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
     112 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
     113 . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
     114 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
     115 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
     116 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
     117 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
     118 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
     119 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
     120 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
     121 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
     122 . K @ALTARYTMP
     123 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
     124 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
     125 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
     126 . S ALTCNT=ALTCNT+1
     127 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
     128 Q
     129PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
     130 ; INGLB IS OF THE FORM: PSNDF(50.6,
     131 ; RETURN 50.6
     132 Q $P($P(INGLB,"(",2),",",1)  ;
Note: See TracChangeset for help on using the changeset viewer.