source: ccr/trunk/p/C0CALERT.m@ 594

Last change on this file since 594 was 590, checked in by Christopher Edwards, 15 years ago

Fix to allow correct DateTime tag to be created
Fix to get the correct alert global
File size: 5.6 KB
Line 
1C0CALERT ; 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 ;
24EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
25 ;
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 . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
49 . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
50 . N ADT S ADT="Patient has an " ; X $ZINT H 5
51 . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
52 . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
53 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
54 . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
55 . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
56 . N ALTCDE ; SNOMED CODE THE THE ALERT
57 . S ALTCDE=$S(A2="P":"282100009",A2="A":"418634005",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
58 . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
59 . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
60 . ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE
61 . I ALTCDE'="" D ; IF THERE IS A CODE
62 . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
63 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
64 . E D ; SET TO NULL
65 . . S @ALTVMAP@("ALERTCODESYSTEM")=""
66 . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
67 . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
68 . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
69 . I ALTPROV'="" D ; PROVIDER PROVIDEED
70 . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
71 . E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
72 . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
73 . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
74 . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
75 . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
76 . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
77 . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
78 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
79 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
80 . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
81 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
82 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
83 . I ACVUID'="" D ; IF VUID IS NOT NULL
84 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
85 . E D ; IF REACTANT CODE VALUE IS NULL
86 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS
87 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
88 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
89 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
90 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
91 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
92 . N ARTMP,ARIEN,ARDES,ARVUID
93 . S (ARTMP,ARDES,ARVUID)=""
94 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS
95 . . S ARTMP=@ALTG@(ALTTMP,"S",1)
96 . . W "REACTION:",ARTMP,!
97 . . S ARIEN=$P(ARTMP,";",2)
98 . . S ARDES=$P(ARTMP,";",1)
99 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
100 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
101 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL
102 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
103 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
104 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM
105 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
106 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
107 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
108 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
109 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
110 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
111 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
112 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
113 . K @ALTARYTMP
114 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
115 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
116 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
117 . S ALTCNT=ALTCNT+1
118 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
119 Q
120PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
121 ; INGLB IS OF THE FORM: PSNDF(50.6,
122 ; RETURN 50.6
123 Q $P($P(INGLB,"(",2),",",1) ;
Note: See TracBrowser for help on using the repository browser.