- 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
