PSODGAL ;BIR/LC-DRUG ALLERGY REACTION CHECKING ;03-Oct-2012 16:10;DU
;;7.0;OUTPATIENT PHARMACY;**26,243,1015**;DEC 1997;Build 62
;External reference to ^GMRADPT supported by DBIA 10099
;External reference to ORCHK^GMRAOR supported by DBIA 2378
;External reference to $P(^GMR(120.8,LP,3),"^",3) supp. by DBIA 2214
;External reference to ^PS(50.605 supported by DBIA 696
;External reference to EN1^GMRAOR2 supported by DBIA 2422
;External reference to GETDATA^GMRAOR supported by DBIA 4847
;External reference to ^TMP("GMRAOC" supported by DBIA 4848
;External reference to ^XUSEC("PSORPH" supported by DBIA 10076
;Modified - IHS/MSC/MGH - 04/06/2012 - Allergy reactions added patch 1014
CHK(DFN,TYP,PTR) ;matched to ndf
;IHS/MSC/MGH - 04/06/2012
;K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSOACK)=1
K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR,"",1,1) D:$G(PSOACK)=1
.Q:$D(^XUSEC("PSORPH",DUZ))
.S ^TMP("PSODAI",$J,0)=1
.S I=0 F S I=$O(GMRAING(I)) Q:'I S ^TMP("PSODAI",$J,I,0)=GMRAING(I)
D:$G(PSOACK)=1 DSPLY
;IHS/MSC/MGH - 04/06/12
;K PSOACK,GMRAING,I
K PSOACK,GMRAING,GMRAREAC,I,GMRACOM
Q
CHK1(DFN) ;not matched to ndf
K ^TMP("PSODAI",$J)
S GMRA="0^0^001" D ^GMRADPT F LP=0:0 S LP=$O(GMRAL(LP)) Q:'LP!($G(PSOACK)) D:$D(^GMR(120.8,LP,0))
.S:'$D(PSOACK) APTR=$P(^GMR(120.8,LP,0),"^",3)
.I $P(APTR,";",2)="PSDRUG(",$P(APTR,";")=PSODRUG("IEN") S PSOACK=1
.Q:$D(^XUSEC("PSORPH",DUZ)) S:$G(PSOACK)=1 ^TMP("PSODAI",$J,0)=1
.;IHS/MSC/MGH Updated for reactions patch 1015
.D GETREAC^GMRAOR(LP)
.D GETCOM^GMRAOR(LP)
D:$G(PSOACK)=1 DSPLY
K APTR,GMRA,GMRAL,LP,PSOACK
Q
;
CLASS(DFN) ;
N CPT,CLCHK,CT,AGNL,CC,GMRA,LEN
S LEN=4
I $E(PSODRUG("VA CLASS"),1,4)="CN10" S LEN=5 ;look at 5 chars if ANALGESICS
K ^TMP($J,"PSODRCLS")
I $T(GETDATA^GMRAOR)]"" G CLASS2 ; CHECK FOR EXISTENCE OF NEW ENTRY POINT BEFORE USING
S CLCHK=""
S GMRA="0^0^111" D ^GMRADPT F CC=0:0 S CC=$O(GMRAL(CC)) Q:'CC D
.K AGNL D EN1^GMRAOR2(CC,"AGNL")
.I $D(AGNL("V")) F CT=0:1 S CPT=$O(AGNL("V",CT)) Q:'CPT I $E($P($G(AGNL("V",CPT)),"^"),1,LEN)=$E(PSODRUG("VA CLASS"),1,LEN) D
..S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=$P($G(AGNL("V",CPT)),"^")_" "_$P($G(AGNL("V",CPT)),"^",2)
..;IHS/MSC/MGH Updated for reactions Patch 1015
..N K S K=0 S K=$O(AGNL("S",K)) Q:'+K D
...I K=1 S ^TMP($J,"PSODRCLS","REAC",K)="Reactions: "_$G(AGNL("S",K))
...E S ^TMP($J,"PSODRCLS","REAC",K)=$G(AGNL("S",K))
..;IHS/MSC/MGH Updated for reactions Patch 1015
..N K S K=0 S K=$O(AGNL("C",K)) Q:'+K D
...I K=1 S ^TMP($J,"PSODRCLS","COM",K)="Comments: "_$G(AGNL("C",K))
...E S ^TMP($J,"PSODRCLS","COM",K)=$G(AGNL("C",K))
..;END MOD
G CLASSDSP
CLASS2 ;
N RET,K,L
S RET=$$DRCL(DFN)
I '$G(RET) Q
S CLCHK="",CT="" F S CT=$O(GMRADRCL(CT)) Q:CT="" D
.I $E(PSODRUG("VA CLASS"),1,LEN)=$E(CT,1,LEN) D
..S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=CT_" "_$P(GMRADRCL(CT),"^",2)
..;IHS/MSC/MGH Modified for adding reactions patch 1015
..S K=0 F S K=$O(GMRAREAC(CT,K)) Q:'+K D
...I K=1 S ^TMP($J,"PSODRCLS","REAC",K)="Reactions: "_$G(GMRAREAC(CT,K))
...E S ^TMP($J,"PSODRCLS",CLCHK,"REAC",K)=$G(GMRAREAC(CT,K))
..;IHS/MSC/MGH Modified for adding comments patch 1015
..S K=0 F S K=$O(GMRACOM(CT,K)) Q:'+K D
...I K=1 S ^TMP($J,"PSODRCLS",CLCHK,"COM",K)="Comments: "_$G(GMRACOM(CT,K))
...E S ^TMP($J,"PSODRCLS",CLCHK,"COM",K)=$G(GMRACOM(CT,K))
..;END MOD
CLASSDSP ;
I '$D(^TMP($J,"PSODRCLS")) Q
W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
W !,"Drug: "_PSODRUG("NAME")
S CT="" F S CT=$O(^TMP($J,"PSODRCLS",CT)) Q:'CT W !,"Drug Class: "_^TMP($J,"PSODRCLS",CT)
;IHS/MSC/MGH added patch 1015 for reactions
S K=0 F S K=$O(^TMP($J,"PSODRCLS","REAC",K)) Q:K="" D
.W !,$G(^TMP($J,"PSODRCLS","REAC",K))
;IHS/MSC/MGH added patch 1015 for comments
S K=0 F S K=$O(^TMP($J,"PSODRCLS","COM",K)) Q:K="" D
.W !,$G(^TMP($J,"PSODRCLS","COM",K))
;END MOD
K ^TMP($J,"PSODRCLS")
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,"
S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR
I Y D ^PSORXI
I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q
Q
DSPLY ;
W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
I $D(^XUSEC("PSORPH",DUZ)) D
.W !,"Drug: "_PSODRUG("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
.I $O(GMRAREAC(0)) D
..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))_", "
.;IHS/MSC/MGH Added for comments
.I $O(GMRACOM(0)) D
..W !,?6,"Comments: "
..S K=0 F S K=$O(GMRACOM(K)) Q:'+K D
...S L=0 F S L=$O(GMRACOM(K,L)) Q:'+L D
....W ?19,$G(GMRACOM(K,L,0))_" "
.;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 ^PSORXI
K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,I,K,L
Q
;
DRCL(DFN) ;
;IHS/MSC/MGH - 04/06/12
;N RET
N RET,J
S RET=0
K GMRADRCL
D GETDATA^GMRAOR(DFN)
Q:'$D(^TMP("GMRAOC",$J,"APC")) 0
N GMRACL
S GMRACL="" F S GMRACL=$O(^TMP("GMRAOC",$J,"APC",GMRACL)) Q:'$L(GMRACL) D
.N GMRANM,GMRALOC
.S GMRALOC=^TMP("GMRAOC",$J,"APC",GMRACL)
.S GMRANM=$P(^PS(50.605,+$O(^PS(50.605,"B",GMRACL,0)),0),U,2)
.S GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")"
.;IHS/MSC/MGH added for reaction data
.S J=0 F S J=$O(^TMP("GMRAOC",$J,"APC",GMRACL,"REAC",J)) Q:'+J D
..S GMRAREAC(GMRACL,J)=$G(^TMP("GMRAOC",$J,"APC",GMRACL,"REAC",J))
.;IHS/MSC/MGH added for comment data
.S J=0 F S J=$O(^TMP("GMRAOC",$J,"APC",GMRACL,"COM",J)) Q:'+J D
..S GMRACOM(GMRACL,J)=$G(^TMP("GMRAOC",$J,"APC",GMRACL,"COM",J))
.;END MOD
.S RET=RET+1
K ^TMP("GMRAOC",$J)
Q RET
PSODGAL ;BIR/LC-DRUG ALLERGY REACTION CHECKING ;03-Oct-2012 16:10;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**26,243,1015**;DEC 1997;Build 62
+2 ;External reference to ^GMRADPT supported by DBIA 10099
+3 ;External reference to ORCHK^GMRAOR supported by DBIA 2378
+4 ;External reference to $P(^GMR(120.8,LP,3),"^",3) supp. by DBIA 2214
+5 ;External reference to ^PS(50.605 supported by DBIA 696
+6 ;External reference to EN1^GMRAOR2 supported by DBIA 2422
+7 ;External reference to GETDATA^GMRAOR supported by DBIA 4847
+8 ;External reference to ^TMP("GMRAOC" supported by DBIA 4848
+9 ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076
+10 ;Modified - IHS/MSC/MGH - 04/06/2012 - Allergy reactions added patch 1014
CHK(DFN,TYP,PTR) ;matched to ndf
+1 ;IHS/MSC/MGH - 04/06/2012
+2 ;K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR) D:$G(PSOACK)=1
+3 KILL ^TMP("PSODAI",$JOB)
SET PSOACK=$$ORCHK^GMRAOR(DFN,TYP,PTR,"",1,1)
IF $GET(PSOACK)=1
Begin DoDot:1
+4 IF $DATA(^XUSEC("PSORPH",DUZ))
QUIT
+5 SET ^TMP("PSODAI",$JOB,0)=1
+6 SET I=0
FOR
SET I=$ORDER(GMRAING(I))
IF 'I
QUIT
SET ^TMP("PSODAI",$JOB,I,0)=GMRAING(I)
End DoDot:1
+7 IF $GET(PSOACK)=1
DO DSPLY
+8 ;IHS/MSC/MGH - 04/06/12
+9 ;K PSOACK,GMRAING,I
+10 KILL PSOACK,GMRAING,GMRAREAC,I,GMRACOM
+11 QUIT
CHK1(DFN) ;not matched to ndf
+1 KILL ^TMP("PSODAI",$JOB)
+2 SET GMRA="0^0^001"
DO ^GMRADPT
FOR LP=0:0
SET LP=$ORDER(GMRAL(LP))
IF 'LP!($GET(PSOACK))
QUIT
IF $DATA(^GMR(120.8,LP,0))
Begin DoDot:1
+3 IF '$DATA(PSOACK)
SET APTR=$PIECE(^GMR(120.8,LP,0),"^",3)
+4 IF $PIECE(APTR,";",2)="PSDRUG("
IF $PIECE(APTR,";")=PSODRUG("IEN")
SET PSOACK=1
+5 IF $DATA(^XUSEC("PSORPH",DUZ))
QUIT
IF $GET(PSOACK)=1
SET ^TMP("PSODAI",$JOB,0)=1
+6 ;IHS/MSC/MGH Updated for reactions patch 1015
+7 DO GETREAC^GMRAOR(LP)
+8 DO GETCOM^GMRAOR(LP)
End DoDot:1
+9 IF $GET(PSOACK)=1
DO DSPLY
+10 KILL APTR,GMRA,GMRAL,LP,PSOACK
+11 QUIT
+12 ;
CLASS(DFN) ;
+1 NEW CPT,CLCHK,CT,AGNL,CC,GMRA,LEN
+2 SET LEN=4
+3 ;look at 5 chars if ANALGESICS
IF $EXTRACT(PSODRUG("VA CLASS"),1,4)="CN10"
SET LEN=5
+4 KILL ^TMP($JOB,"PSODRCLS")
+5 ; CHECK FOR EXISTENCE OF NEW ENTRY POINT BEFORE USING
IF $TEXT(GETDATA^GMRAOR)]""
GOTO CLASS2
+6 SET CLCHK=""
+7 SET GMRA="0^0^111"
DO ^GMRADPT
FOR CC=0:0
SET CC=$ORDER(GMRAL(CC))
IF 'CC
QUIT
Begin DoDot:1
+8 KILL AGNL
DO EN1^GMRAOR2(CC,"AGNL")
+9 IF $DATA(AGNL("V"))
FOR CT=0:1
SET CPT=$ORDER(AGNL("V",CT))
IF 'CPT
QUIT
IF $EXTRACT($PIECE($GET(AGNL("V",CPT)),"^"),1,LEN)=$EXTRACT(PSODRUG("VA CLASS"),1,LEN)
Begin DoDot:2
+10 SET CLCHK=$GET(CLCHK)+1
SET ^TMP($JOB,"PSODRCLS",CLCHK)=$PIECE($GET(AGNL("V",CPT)),"^")_" "_$PIECE($GET(AGNL("V",CPT)),"^",2)
+11 ;IHS/MSC/MGH Updated for reactions Patch 1015
+12 NEW K
SET K=0
SET K=$ORDER(AGNL("S",K))
IF '+K
QUIT
Begin DoDot:3
+13 IF K=1
SET ^TMP($JOB,"PSODRCLS","REAC",K)="Reactions: "_$GET(AGNL("S",K))
+14 IF '$TEST
SET ^TMP($JOB,"PSODRCLS","REAC",K)=$GET(AGNL("S",K))
End DoDot:3
+15 ;IHS/MSC/MGH Updated for reactions Patch 1015
+16 NEW K
SET K=0
SET K=$ORDER(AGNL("C",K))
IF '+K
QUIT
Begin DoDot:3
+17 IF K=1
SET ^TMP($JOB,"PSODRCLS","COM",K)="Comments: "_$GET(AGNL("C",K))
+18 IF '$TEST
SET ^TMP($JOB,"PSODRCLS","COM",K)=$GET(AGNL("C",K))
End DoDot:3
+19 ;END MOD
End DoDot:2
End DoDot:1
+20 GOTO CLASSDSP
CLASS2 ;
+1 NEW RET,K,L
+2 SET RET=$$DRCL(DFN)
+3 IF '$GET(RET)
QUIT
+4 SET CLCHK=""
SET CT=""
FOR
SET CT=$ORDER(GMRADRCL(CT))
IF CT=""
QUIT
Begin DoDot:1
+5 IF $EXTRACT(PSODRUG("VA CLASS"),1,LEN)=$EXTRACT(CT,1,LEN)
Begin DoDot:2
+6 SET CLCHK=$GET(CLCHK)+1
SET ^TMP($JOB,"PSODRCLS",CLCHK)=CT_" "_$PIECE(GMRADRCL(CT),"^",2)
+7 ;IHS/MSC/MGH Modified for adding reactions patch 1015
+8 SET K=0
FOR
SET K=$ORDER(GMRAREAC(CT,K))
IF '+K
QUIT
Begin DoDot:3
+9 IF K=1
SET ^TMP($JOB,"PSODRCLS","REAC",K)="Reactions: "_$GET(GMRAREAC(CT,K))
+10 IF '$TEST
SET ^TMP($JOB,"PSODRCLS",CLCHK,"REAC",K)=$GET(GMRAREAC(CT,K))
End DoDot:3
+11 ;IHS/MSC/MGH Modified for adding comments patch 1015
+12 SET K=0
FOR
SET K=$ORDER(GMRACOM(CT,K))
IF '+K
QUIT
Begin DoDot:3
+13 IF K=1
SET ^TMP($JOB,"PSODRCLS",CLCHK,"COM",K)="Comments: "_$GET(GMRACOM(CT,K))
+14 IF '$TEST
SET ^TMP($JOB,"PSODRCLS",CLCHK,"COM",K)=$GET(GMRACOM(CT,K))
End DoDot:3
+15 ;END MOD
End DoDot:2
End DoDot:1
CLASSDSP ;
+1 IF '$DATA(^TMP($JOB,"PSODRCLS"))
QUIT
+2 WRITE $CHAR(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
+3 WRITE !,"Drug: "_PSODRUG("NAME")
+4 SET CT=""
FOR
SET CT=$ORDER(^TMP($JOB,"PSODRCLS",CT))
IF 'CT
QUIT
WRITE !,"Drug Class: "_^TMP($JOB,"PSODRCLS",CT)
+5 ;IHS/MSC/MGH added patch 1015 for reactions
+6 SET K=0
FOR
SET K=$ORDER(^TMP($JOB,"PSODRCLS","REAC",K))
IF K=""
QUIT
Begin DoDot:1
+7 WRITE !,$GET(^TMP($JOB,"PSODRCLS","REAC",K))
End DoDot:1
+8 ;IHS/MSC/MGH added patch 1015 for comments
+9 SET K=0
FOR
SET K=$ORDER(^TMP($JOB,"PSODRCLS","COM",K))
IF K=""
QUIT
Begin DoDot:1
+10 WRITE !,$GET(^TMP($JOB,"PSODRCLS","COM",K))
End DoDot:1
+11 ;END MOD
+12 KILL ^TMP($JOB,"PSODRCLS")
+13 SET DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"
+14 SET DIR("?")=" 'NO' if you DON'T want to enter a reaction for this medication,"
+15 SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene? "
SET DIR("B")="Y"
WRITE !
DO ^DIR
+16 IF Y
DO ^PSORXI
+17 IF '$GET(Y)
KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y
QUIT
+18 QUIT
DSPLY ;
+1 WRITE $CHAR(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",!
+2 IF $DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:1
+3 WRITE !,"Drug: "_PSODRUG("NAME")
IF $ORDER(GMRAING(0))
WRITE !,?6,"Ingredients: "
+4 SET DIR("?",1)="Answer 'YES' if you DO want to enter a reaction for this medication,"
+5 SET DIR("?")=" 'NO' if you DON'T want to enter a reaction for this medication,"
+6 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))_", "
+7 ;IHS/MSC/MGH Added for reactions
+8 IF $ORDER(GMRAREAC(0))
Begin DoDot:2
+9 WRITE !,?6,"Reactions: "
+10 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))_", "
End DoDot:2
+11 ;IHS/MSC/MGH Added for comments
+12 IF $ORDER(GMRACOM(0))
Begin DoDot:2
+13 WRITE !,?6,"Comments: "
+14 SET K=0
FOR
SET K=$ORDER(GMRACOM(K))
IF '+K
QUIT
Begin DoDot:3
+15 SET L=0
FOR
SET L=$ORDER(GMRACOM(K,L))
IF '+L
QUIT
Begin DoDot:4
+16 WRITE ?19,$GET(GMRACOM(K,L,0))_" "
End DoDot:4
End DoDot:3
End DoDot:2
+17 ;END MOD
+18 SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene? "
SET DIR("B")="Y"
WRITE !
DO ^DIR
+19 IF 'Y
KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y
QUIT
+20 IF Y
DO ^PSORXI
End DoDot:1
+21 KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,I,K,L
+22 QUIT
+23 ;
DRCL(DFN) ;
+1 ;IHS/MSC/MGH - 04/06/12
+2 ;N RET
+3 NEW RET,J
+4 SET RET=0
+5 KILL GMRADRCL
+6 DO GETDATA^GMRAOR(DFN)
+7 IF '$DATA(^TMP("GMRAOC",$JOB,"APC"))
QUIT 0
+8 NEW GMRACL
+9 SET GMRACL=""
FOR
SET GMRACL=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRACL))
IF '$LENGTH(GMRACL)
QUIT
Begin DoDot:1
+10 NEW GMRANM,GMRALOC
+11 SET GMRALOC=^TMP("GMRAOC",$JOB,"APC",GMRACL)
+12 SET GMRANM=$PIECE(^PS(50.605,+$ORDER(^PS(50.605,"B",GMRACL,0)),0),U,2)
+13 SET GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")"
+14 ;IHS/MSC/MGH added for reaction data
+15 SET J=0
FOR
SET J=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRACL,"REAC",J))
IF '+J
QUIT
Begin DoDot:2
+16 SET GMRAREAC(GMRACL,J)=$GET(^TMP("GMRAOC",$JOB,"APC",GMRACL,"REAC",J))
End DoDot:2
+17 ;IHS/MSC/MGH added for comment data
+18 SET J=0
FOR
SET J=$ORDER(^TMP("GMRAOC",$JOB,"APC",GMRACL,"COM",J))
IF '+J
QUIT
Begin DoDot:2
+19 SET GMRACOM(GMRACL,J)=$GET(^TMP("GMRAOC",$JOB,"APC",GMRACL,"COM",J))
End DoDot:2
+20 ;END MOD
+21 SET RET=RET+1
End DoDot:1
+22 KILL ^TMP("GMRAOC",$JOB)
+23 QUIT RET
