PXRMART.m

PXRMART ;SLC/DAN - ART computed finding ;08/01/2013

 ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404

 ;Refererences to ^GMR(120.8 covered by DBIA #905.

ARTCL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;

 S TEST=$$UP^XLFSTR(TEST)

 S NFOUND=0

 Q:TEST=""!(NGET=0)!("^IN:^DR:^"'[("^"_$E(TEST,1,3)_"^"))

 N WILD,ITEM,SUB,ING,INGT,TERM

 S WILD=$S(TEST["*":1,1:0),SUB=$S($E(TEST,1,2)="IN":"API",1:"APC")

 S TEST=$P(TEST,":",2)

 I 'WILD S ITEM=$S(SUB="API":+$O(^PS(50.416,"B",TEST,0)),1:TEST) Q:ITEM=0  D GETINFO Q

 S ITEM=$E(TEST,1,$L($P(TEST,"*")))

 I SUB="APC" F  S ITEM=$O(^GMR(120.8,SUB,DFN,ITEM)) Q:ITEM=""!(ITEM'[($E(TEST,1,$L($P(TEST,"*")))))!(NFOUND=NGET)  D GETINFO

 I SUB="API" S TERM=ITEM,ING=0 F  S ING=$O(^GMR(120.8,SUB,DFN,ING)) Q:'+ING  S INGT=$P(^PS(50.416,ING,0),U) I $E(INGT,1,$L(TERM))=TERM S ITEM=ING D GETINFO

 Q

 ;

GETINFO ;

 N EDATE,IEN,GMRA0,GMRDATA

 S IEN="" F  S IEN=$O(^GMR(120.8,SUB,DFN,ITEM,IEN),-1) Q:'+IEN!(NFOUND=NGET)  D

 .S GMRAR0=^GMR(120.8,IEN,0)

 .S EDATE=$P(GMRAR0,U,4)

 .Q:EDATE<BDT!(EDATE>EDT)

 .S NFOUND=NFOUND+1,TEST(NFOUND)=1,DATE(NFOUND)=EDATE

 .S DATA(NFOUND,"REACTANT")=$P(GMRAR0,U,2)

 .S DATA(NFOUND,"OBSERVED/HISTORICAL")=$$EXTERNAL^DILFD(120.8,6,"",$P(GMRAR0,U,6))

 .S DATA(NFOUND,"MECHANISM")=$$EXTERNAL^DILFD(120.8,17,"",$P(GMRAR0,U,14))

 .S DATA(NFOUND,"ALLERGY TYPE")=$P(GMRAR0,U,20)

 .S TEXT(NFOUND)="Documented reaction "_$S(SUB="API":"that includes the ingredient ",1:"to an agent in class ")_$S(SUB="APC":ITEM,1:$P(^PS(50.416,ITEM,0),U))_", reactant was: "_DATA(NFOUND,"REACTANT")_"."

 Q

PXRMART   ;SLC/DAN - ART computed finding ;08/01/2013

 +1       ;;2.0;CLINICAL REMINDERS;**26**;Feb 04, 2005;Build 404

 +2       ;Refererences to ^GMR(120.8 covered by DBIA #905.

ARTCL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;

 +1        SET TEST=$$UP^XLFSTR(TEST)

 +2        SET NFOUND=0

 +3        IF TEST=""!(NGET=0)!("^IN

               QUIT 

 +4        NEW WILD,ITEM,SUB,ING,INGT,TERM

 +5        SET WILD=$SELECT(TEST["*":1,1:0)

           SET SUB=$SELECT($EXTRACT(TEST,1,2)="IN":"API",1:"APC")

 +6        SET TEST=$PIECE(TEST,":",2)

 +7        IF 'WILD

               SET ITEM=$SELECT(SUB="API":+$ORDER(^PS(50.416,"B",TEST,0)),1:TEST)

               IF ITEM=0

                   QUIT 

               DO GETINFO

               QUIT 

 +8        SET ITEM=$EXTRACT(TEST,1,$LENGTH($PIECE(TEST,"*")))

 +9        IF SUB="APC"

               FOR 

                   SET ITEM=$ORDER(^GMR(120.8,SUB,DFN,ITEM))

                   IF ITEM=""!(ITEM'[($EXTRACT(TEST,1,$LENGTH($PIECE(TEST,"*")))))!(NFOUND=NGET)

                       QUIT 

                   DO GETINFO

 +10       IF SUB="API"

               SET TERM=ITEM

               SET ING=0

               FOR 

                   SET ING=$ORDER(^GMR(120.8,SUB,DFN,ING))

                   IF '+ING

                       QUIT 

                   SET INGT=$PIECE(^PS(50.416,ING,0),U)

                   IF $EXTRACT(INGT,1,$LENGTH(TERM))=TERM

                       SET ITEM=ING

                       DO GETINFO

 +11       QUIT 

 +12      ;

GETINFO   ;

 +1        NEW EDATE,IEN,GMRA0,GMRDATA

 +2        SET IEN=""

           FOR 

               SET IEN=$ORDER(^GMR(120.8,SUB,DFN,ITEM,IEN),-1)

               IF '+IEN!(NFOUND=NGET)

                   QUIT 

               Begin DoDot:1

 +3                SET GMRAR0=^GMR(120.8,IEN,0)

 +4                SET EDATE=$PIECE(GMRAR0,U,4)

 +5                IF EDATE<BDT!(EDATE>EDT)

                       QUIT 

 +6                SET NFOUND=NFOUND+1

                   SET TEST(NFOUND)=1

                   SET DATE(NFOUND)=EDATE

 +7                SET DATA(NFOUND,"REACTANT")=$PIECE(GMRAR0,U,2)

 +8                SET DATA(NFOUND,"OBSERVED/HISTORICAL")=$$EXTERNAL^DILFD(120.8,6,"",$PIECE(GMRAR0,U,6))

 +9                SET DATA(NFOUND,"MECHANISM")=$$EXTERNAL^DILFD(120.8,17,"",$PIECE(GMRAR0,U,14))

 +10               SET DATA(NFOUND,"ALLERGY TYPE")=$PIECE(GMRAR0,U,20)

 +11               SET TEXT(NFOUND)="Documented reaction "_$SELECT(SUB="API":"that includes the ingredient ",1:"to an agent in class ")_$SELECT(SUB="APC":ITEM,1:$PIECE(^PS(50.416,ITEM,0),U))_", reactant was: "_DATA(NFOUND,"REACTANT")_"."

               End DoDot:1

 +12       QUIT