- Timestamp:
- Oct 25, 2008, 11:05:53 AM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 2 edited
-
GPLALERT.m (modified) (1 diff)
-
GPLSNOA.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLALERT.m
r153 r223 1 1 GPLALERT ; CCDCCR/CKU - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 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 ; 23 23 EXTRACT(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 32 67 33 ; DEFINE MAPPING34 N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP35 S ALTTVMAP=$NA(^TMP("GPLALERT",$J,"ALERTS"))36 S ALTTARYTMP=$NA(^TMP("GPLALERT",$J,"ALERTSARYTMP"))37 K @ALTTVMAP,@ALTTARYTMP38 N ALTTMP,ALTCNT S ALTTMP=$NA(GMRAL),ALTCNT=139 F S ALTTMP=$Q(@ALTTMP) Q:ALTTMP="" D40 . I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q41 . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))42 . K @ALTVMAP43 . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT44 . N ALERTDESCRIPTIONTEXT S ALERTDESCRIPTIONTEXT="Patient has an " ; X $ZINT H 545 . 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")=ALERTDESCRIPTIONTEXT48 . 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 @ALTARYTMP59 . 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+163 64 Q65 -
ccr/trunk/p/GPLSNOA.m
r222 r223 175 175 Q 176 176 ; 177 REUSE ; 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.
