Changeset 223 for ccr


Ignore:
Timestamp:
Oct 25, 2008, 11:05:53 AM (16 years ago)
Author:
George Lilly
Message:

added REACTION variables to alert processing

Location:
ccr/trunk/p
Files:
2 edited

Legend:

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

    r153 r223  
    11GPLALERT  ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
    2           ;;0.1;CCDCCR;;SEP 11,2008;
    3           ;Copyright 2008 WorldVistA.  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           W "NO ENTRY FROM TOP",!
    21           Q
    22           ;
     2 ;;0.1;CCDCCR;;SEP 11,2008;
     3 ;Copyright 2008 WorldVistA.  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 W "NO ENTRY FROM TOP",!
     21 Q
     22 ;
    2323EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
    24           ;
    25           ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    26           ;
    27           ; GET ADVERSE REACTIONS AND ALLERGIES
    28           N GMRA,GMRAL S GMRA="0^0^111"
    29           D EN1^GMRADPT
    30           I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
    31           . S @ALTOUTXML@(0)=0
     24 ;
     25 ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     26 ;
     27 ; GET ADVERSE REACTIONS AND ALLERGIES
     28 ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
     29 S GMRA="0^0^111"
     30 D EN1^GMRADPT
     31 I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
     32 . S @ALTOUTXML@(0)=0
     33 ; DEFINE MAPPING
     34 N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
     35 S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))
     36 S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))
     37 K @ALTTVMAP,@ALTTARYTMP
     38 N ALTTMP,ALTCNT S ALTTMP=$NA(GMRAL),ALTCNT=1
     39 F  S ALTTMP=$Q(@ALTTMP) Q:ALTTMP=""  D
     40 . I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
     41 . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
     42 . K @ALTVMAP
     43 . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
     44 . N ADT S ADT="Patient has an " ; X $ZINT H 5
     45 . S ADT=ADT_$S($P(@ALTTMP,U,4)=1:"ADVERSE",$P(@ALTTMP,U,5)=1:"ALLERGIC",1:"UNKNOWN")
     46 . S ADT=ADT_" reaction to "_$P(@ALTTMP,U,2)_"."
     47 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
     48 . S @ALTVMAP@("ALERTCODEVALUE")="ALERT CODE VALUE"
     49 . S @ALTVMAP@("ALERTCODESYSTEM")="ALERT CODE SYSTEM"
     50 . S @ALTVMAP@("ALERTSTATUSTEXT")="ALERT STATUS TEXT"
     51 . S @ALTVMAP@("ALERTSOURCEID")="ALERT SOURCE ID"
     52 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="ALERT AGENT PRODUCT OBJECT ID"
     53 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="A"
     54 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")="B"
     55 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="C"
     56 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="D"
     57 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")="E"
     58 . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="F"
     59 . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="G"
     60 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
     61 . K @ALTARYTMP
     62 . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
     63 . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
     64 . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
     65 . S ALTCNT=ALTCNT+1
     66 Q
    3267
    33           ; DEFINE MAPPING
    34           N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
    35           S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))
    36           S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))
    37           K @ALTTVMAP,@ALTTARYTMP
    38           N ALTTMP,ALTCNT S ALTTMP=$NA(GMRAL),ALTCNT=1
    39           F  S ALTTMP=$Q(@ALTTMP) Q:ALTTMP=""  D
    40           . I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
    41           . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
    42           . K @ALTVMAP
    43           . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
    44           . N ALERTDESCRIPTIONTEXT S ALERTDESCRIPTIONTEXT="Patient has an " ; X $ZINT H 5
    45           . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_$S($P(@ALTTMP,U,4)=1:"ADVERSE",$P(@ALTTMP,U,5)=1:"ALLERGIC",1:"UNKNOWN")
    46           . S ALERTDESCRIPTIONTEXT=ALERTDESCRIPTIONTEXT_" reaction to "_$P(@ALTTMP,U,2)_"."
    47           . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ALERTDESCRIPTIONTEXT
    48           . S @ALTVMAP@("ALERTCODEVALUE")="ALERT CODE VALUE"
    49           . S @ALTVMAP@("ALERTCODESYSTEM")="ALERT CODE SYSTEM"
    50           . S @ALTVMAP@("ALERTSTATUSTEXT")="ALERT STATUS TEXT"
    51           . S @ALTVMAP@("ALERTSOURCEID")="ALERT SOURCE ID"
    52           . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="ALERT AGENT PRODUCT OBJECT ID"
    53           . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="A"
    54           . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")="B"
    55           . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="C"
    56           . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="D"
    57           . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
    58           . K @ALTARYTMP
    59           . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
    60           . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)
    61           . I ALTCNT>1 D INSINNER^GPLXPATH(ALTOUTXML,ALTARYTMP)
    62           . S ALTCNT=ALTCNT+1
    63 
    64           Q
    65 
  • ccr/trunk/p/GPLSNOA.m

    r222 r223  
    175175    Q
    176176    ;
     177REUSE ; GET SAVED VALUES FROM ^TMP("GPLSAV") AND PUT THEM IN A DATABASE
     178 ;
     179 D ASETUP
     180 D AINIT
     181 N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
     182 S SAVBASE=$NA(^TMP("GPLSAV","VARS"))
     183 S SNOI=""
     184 F  D  Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
     185 . S SNOI=$O(@SAVBASE@(SNOI))
     186 . S SNOJ=@SAVBASE@(SNOI)
     187 . S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
     188 . S SNOSRCH=$P(SNOJ,"^",1) ;SEARCH TERM USED TO OBTAIN SNOMED CODE
     189 . S SNOIEN=$P(SNOJ,"^",3) ; IEN OF ELEMENT IN LEXICON
     190 . S SNOSNO=$P(SNOJ,"^",4) ; SNOMED CODE
     191 . S SNOSEC=$P(SNOJ,"^",5) ; SECTION OF SNOMED FOR THIS CODE
     192 . S SNOOLD=$P(SNOJ,"^",7) ; OLD NUMBER FOR THIS CODE
     193 . W "SEARCH:",SNOSRCH," IEN:",SNOIEN," CODE:",SNOSNO," SEC:",SNOSEC," OLD:",SNOOLD,!
     194 . W SNOK,!
     195 . W SNOJ,!
     196 Q
     197 ;
Note: See TracChangeset for help on using the changeset viewer.