PSJDGAL.m

PSJDGAL ;BIR/LC-DRUG/ALLERGY REACTION CHECKING ;29-May-2012 14:37;PLS

 ;;5.0; INPATIENT MEDICATIONS ;1015;16 DEC 97;Build 62

 ;Modified - IHS/MSC/MGH - 04/06/2012 -

 ;

CHK(DFN,TYP,PTR) ;

 N APTR

 ;IHS/MSC/MGH - 04/06/12

 ;K ^TMP("PSJDAI",$J) S PSJACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSJACK)=1

 K ^TMP("PSJDAI",$J) S PSJACK=$$ORCHK^GMRAOR(DFN,TYP,PTR,"",1) D:$G(PSJACK)=1

 .;Q:$D(^XUSEC("PSJRPH",DUZ))

 .S ^TMP("PSJDAI",$J,0)=1

 .S I=0 F  S I=$O(GMRAING(I)) Q:'I  S ^TMP("PSJDAI",$J,I,0)=GMRAING(I)

 D:$G(PSJACK)=1 DSPLY

 K PSJACK,GMRAING,I

 Q

CHK1(DFN) ;

 K ^TMP("PSJDAI",$J)

 S GMRA="0^0^001" D EN1^GMRADPT F LP=0:0 S LP=$O(GMRAL(LP)) Q:'LP!($G(PSJACK))  D

 .S:'$D(PSJACK) APTR=$P(^GMR(120.8,LP,0),"^",3)

 .I $P(APTR,";",2)="PSDRUG(",$P(APTR,";")=PSJDRUG("IEN") S PSJACK=1

 .;Q:$D(^XUSEC("PSJRPH",DUZ))

 .S ^TMP("PSODAI",$J,0)=1

 D:$G(PSJACK)=1 DSPLY

 K GMRA,GMRAL,LP,PSOACK

 Q

DSPLY ;

 W $C(7),!,"A Drug-Allergy Reaction exists for this medication!",!

 ;I $D(^XUSEC("PSJRPH",DUZ)) D

 D

 .W $C(7),!,"***SIGNIFICANT*** Allergy Reaction"

 .W !,"Drug: "_PSJDRUG("NAME") I $O(GMRAING(0)) W !,?6,"Ingredients: "

 .S DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"

 .S DIR("?")="       'NO' if you DON'T want to enter a reaction for this medication,"

 .W ?19 S I=0 F  S I=$O(GMRAING(I)) Q:'I  W:$X+$L($G(GMRAING(I)))+2>IOM !?19 W $G(GMRAING(I))_", "

 .;IHS/MSC/MGH Added for reactions Patch 1014

 .I $O(GMRAREAC(0)) W !,?6,"Reactions: "

 .W ?19 S I=0 F  S I=$O(GMRAREAC(I)) Q:'I  W:$X+$L($G(GMRAREAC(I)))+2>IOM !?19 W $G(GMRAREAC(I))_", "

 .;END MOD

 .S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR

 .I 'Y K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q

 .I Y D ^PSJRXI

 K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y

 Q

PSJDGAL   ;BIR/LC-DRUG/ALLERGY REACTION CHECKING ;29-May-2012 14:37;PLS

 +1       ;;5.0; INPATIENT MEDICATIONS ;1015;16 DEC 97;Build 62

 +2       ;Modified - IHS/MSC/MGH - 04/06/2012 -

 +3       ;

CHK(DFN,TYP,PTR) ;

 +1        NEW APTR

 +2       ;IHS/MSC/MGH - 04/06/12

 +3       ;K ^TMP("PSJDAI",$J) S PSJACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSJACK)=1

 +4        KILL ^TMP("PSJDAI",$JOB)

           SET PSJACK=$$ORCHK^GMRAOR(DFN,TYP,PTR,"",1)

           IF $GET(PSJACK)=1

               Begin DoDot:1

 +5       ;Q:$D(^XUSEC("PSJRPH",DUZ))

 +6                SET ^TMP("PSJDAI",$JOB,0)=1

 +7                SET I=0

                   FOR 

                       SET I=$ORDER(GMRAING(I))

                       IF 'I

                           QUIT 

                       SET ^TMP("PSJDAI",$JOB,I,0)=GMRAING(I)

               End DoDot:1

 +8        IF $GET(PSJACK)=1

               DO DSPLY

 +9        KILL PSJACK,GMRAING,I

 +10       QUIT 

CHK1(DFN) ;

 +1        KILL ^TMP("PSJDAI",$JOB)

 +2        SET GMRA="0^0^001"

           DO EN1^GMRADPT

           FOR LP=0:0

               SET LP=$ORDER(GMRAL(LP))

               IF 'LP!($GET(PSJACK))

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(PSJACK)

                       SET APTR=$PIECE(^GMR(120.8,LP,0),"^",3)

 +4                IF $PIECE(APTR,";",2)="PSDRUG("

                       IF $PIECE(APTR,";")=PSJDRUG("IEN")

                           SET PSJACK=1

 +5       ;Q:$D(^XUSEC("PSJRPH",DUZ))

 +6                SET ^TMP("PSODAI",$JOB,0)=1

               End DoDot:1

 +7        IF $GET(PSJACK)=1

               DO DSPLY

 +8        KILL GMRA,GMRAL,LP,PSOACK

 +9        QUIT 

DSPLY     ;

 +1        WRITE $CHAR(7),!,"A Drug-Allergy Reaction exists for this medication!",!

 +2       ;I $D(^XUSEC("PSJRPH",DUZ)) D

 +3        Begin DoDot:1

 +4            WRITE $CHAR(7),!,"***SIGNIFICANT*** Allergy Reaction"

 +5            WRITE !,"Drug: "_PSJDRUG("NAME")

               IF $ORDER(GMRAING(0))

                   WRITE !,?6,"Ingredients: "

 +6            SET DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"

 +7            SET DIR("?")="       'NO' if you DON'T want to enter a reaction for this medication,"

 +8            WRITE ?19

               SET I=0

               FOR 

                   SET I=$ORDER(GMRAING(I))

                   IF 'I

                       QUIT 

                   IF $X+$LENGTH($GET(GMRAING(I)))+2>IOM

                       WRITE !?19

                   WRITE $GET(GMRAING(I))_", "

 +9       ;IHS/MSC/MGH Added for reactions Patch 1014

 +10           IF $ORDER(GMRAREAC(0))

                   WRITE !,?6,"Reactions: "

 +11           WRITE ?19

               SET I=0

               FOR 

                   SET I=$ORDER(GMRAREAC(I))

                   IF 'I

                       QUIT 

                   IF $X+$LENGTH($GET(GMRAREAC(I)))+2>IOM

                       WRITE !?19

                   WRITE $GET(GMRAREAC(I))_", "

 +12      ;END MOD

 +13           SET DIR(0)="SA^1:YES;0:NO"

               SET DIR("A")="Do you want to Intervene? "

               SET DIR("B")="Y"

               WRITE !

               DO ^DIR

 +14           IF 'Y

                   KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y

                   QUIT 

 +15           IF Y

                   DO ^PSJRXI

           End DoDot:1

 +16       KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y

 +17       QUIT