Changeset 230
- Timestamp:
- Oct 27, 2008, 12:04:27 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLALER2.m
r229 r230 44 44 . K @ALTVMAP 45 45 . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT 46 . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES 47 . N A2 S A2=$P(A1,U,4) ; ALLERGIC FLAG 48 . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG 46 49 . N ADT S ADT="Patient has an " ; X $ZINT H 5 47 . S ADT=ADT_$S( $P(@ALTG@(ALTTMP),U,4)=1:"ADVERSE",$P(@ALTG@(ALTTMP),U,5)=1:"ALLERGIC",1:"UNKNOWN")50 . S ADT=ADT_$S(A1=1:"ADVERSE",A2=1:"ALLERGIC",1:"UNKNOWN") 48 51 . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"." 49 52 . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT 50 . S @ALTVMAP@("ALERTCODEVALUE")="ALERT CODE VALUE" 51 . S @ALTVMAP@("ALERTCODESYSTEM")="ALERT CODE SYSTEM" 52 . S @ALTVMAP@("ALERTSTATUSTEXT")="ALERT STATUS TEXT" 53 . N ALTCDE ; SNOMED CODE THE THE ALERT 54 . S ALTCDE=$S(A2=1:"282100009",1:"418634005") ; IF NOT ADVERSE, IT IS ALLERGIC 55 . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ; 56 . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE 57 . ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE 58 . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT" 59 . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008" 60 . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS? 53 61 . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN 54 62 . I ALTPROV'="" D ; PROVIDER PROVIDEED … … 56 64 . E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN 57 65 . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),! 58 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCTOBJID" 59 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="A" 60 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")="B" 61 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")="C" 62 . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="D" 63 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")="E" 64 . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="F" 65 . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="G" 66 . N ACGL1,ACGFI,ACIEN,ACVUID 67 . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z, 68 . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER 69 . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT 70 . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT 71 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT 72 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS? 73 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=$P(@ALTG@(ALTTMP),U,2) ; REACTANT 74 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID 75 . I ACVUID'="" D ; IF VUID IS NOT NULL 76 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID" 77 . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW 78 . N ARTMP,ARIEN,ARDES,ARVUID 79 . S ARTMP=@ALTG@(ALTTMP,"S",1) 80 . W "REACTION:",ARTMP,! 81 . S ARIEN=$P(ARTMP,";",2) 82 . S ARDES=$P(ARTMP,";",1) 83 . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID") 84 . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES 85 . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID 86 . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID" 66 87 . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) 67 88 . K @ALTARYTMP … … 71 92 . S ALTCNT=ALTCNT+1 72 93 Q 73 94 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER 95 ; INGLB IS OF THE FORM: PSNDF(50.6, 96 ; RETURN 50.6 97 Q $P($P(INGLB,"(",2),",",1) ;
Note:
See TracChangeset
for help on using the changeset viewer.