Changeset 1204 for ccr/trunk/p/C0CALERT.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CALERT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CALERT.m
r666 r1204 1 C0CALERT ; 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 ; 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":"418634005",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 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID 84 . I ACVUID'="" D ; IF VUID IS NOT NULL 85 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID" 86 . E D ; IF REACTANT CODE VALUE IS NULL 87 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 88 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 89 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 90 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 91 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="" 92 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 93 . N ARTMP,ARIEN,ARDES,ARVUID 94 . S (ARTMP,ARDES,ARVUID)="" 95 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS 96 . . S ARTMP=@ALTG@(ALTTMP,"S",1) 97 . . W "REACTION:",ARTMP,! 98 . . S ARIEN=$P(ARTMP,";",2) 99 . . S ARDES=$P(ARTMP,";",1) 100 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 101 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 102 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL 103 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 104 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 105 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM 106 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" 107 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" 108 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 109 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION 110 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 111 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME 112 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") 113 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT") 114 . K @ALTARYTMP 115 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) 116 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) 117 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) 118 . S ALTCNT=ALTCNT+1 119 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 120 Q 121 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 122 ; INGLB IS OF THE FORM: PSNDF(50.6, 123 ; RETURN 50.6 124 Q $P($P(INGLB,"(",2),",",1) ; 1 C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 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 . I ACVUID'="" D ; IF VUID IS NOT NULL 85 . . S ZC=$$CODE^C0CUTIL(ACVUID) 86 . . S ZCD=$P(ZC,"^",1) ; CODE TO USE 87 . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID 88 . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION 89 . E D ; IF REACTANT CODE VALUE IS NULL 90 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 91 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 92 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 93 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 94 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="" 95 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD 96 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS 97 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD 98 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD 99 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 100 . N ARTMP,ARIEN,ARDES,ARVUID 101 . S (ARTMP,ARDES,ARVUID)="" 102 . I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS 103 . . S ARTMP=@ALTG@(ALTTMP,"S",1) 104 . . W "REACTION:",ARTMP,! 105 . . S ARIEN=$P(ARTMP,";",2) 106 . . S ARDES=$P(ARTMP,";",1) 107 . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 108 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 109 . I ARVUID'="" D ; IF REACTION VUID IS NOT NULL 110 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 111 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 112 . E D ; IF IT IS NULL DON'T SET CODE SYSTEM 113 . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" 114 . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" 115 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 116 . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION 117 . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL 118 . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME 119 . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") 120 . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT") 121 . K @ALTARYTMP 122 . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP) 123 . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML) 124 . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP) 125 . S ALTCNT=ALTCNT+1 126 S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS 127 Q 128 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 129 ; INGLB IS OF THE FORM: PSNDF(50.6, 130 ; RETURN 50.6 131 Q $P($P(INGLB,"(",2),",",1) ;
Note:
See TracChangeset
for help on using the changeset viewer.
