Changeset 1544 for ccr/trunk/p/C0CALERT.m
- Timestamp:
- Oct 1, 2012, 9:32:46 PM (12 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
C0CALERT.m (modified) (1 diff, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p
-
Property svn:mergeinfo
set to (toggle deleted branches)
/ccr/branches/ohum/p merged eligible /ccr/branches/ohum/o-old/p 1290 /ccr/branches/ohum/p/p 1287-1289
-
Property svn:mergeinfo
set to (toggle deleted branches)
-
ccr/trunk/p/C0CALERT.m
-
Property svn:mergeinfo
set to (toggle deleted branches)
/ccr/branches/ohum/p/C0CALERT.m merged eligible /ccr/branches/ohum/o-old/p/C0CALERT.m 1290 /ccr/branches/ohum/p/p/C0CALERT.m 1287-1289
r1336 r1544 1 C0CALERT 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 PRSGLB(INGLB) 130 131 132 1 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 ;;1.2;C0C;;May 11, 2012;Build 47 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) ; -
Property svn:mergeinfo
set to (toggle deleted branches)
Note:
See TracChangeset
for help on using the changeset viewer.
