source: ccr/trunk/p/GPLALERT.m@ 216

Last change on this file since 216 was 153, checked in by chrisu, 16 years ago

finally something that works for me ;) wip

File size: 3.2 KB
Line 
1GPLALERT ; 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 ;
23EXTRACT(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
32
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
Note: See TracBrowser for help on using the repository browser.