PSJDGCK ;HP/MJE - Drug Interaction Utility ;09/22/11 5:00pm
;;5.0;INPATIENT MEDICATIONS;**260,288,281**;16 DEC 97;Build 113
;External references to ^PSSDSAPM supported by DBIA 5570
;
DGCK ;
S PSJDGCK=1,PSJDGCKX=1
D FULL^VALM1
I $D(PSJDGCK)&($G(VALM("TITLE"))="IV Order Entry") D EN^PSJO1(2)
I $$DGCKIEN^PSJDGCK()=""!$P($$DGCKIEN^PSJDGCK(),";",2)=0 D
.W !!,"Not enough active profile drugs to perform drug check",!
.K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
E D ^PSGOE7
DGCKEND S VALMBCK="R"
K PSJDGCK,^TMP($J,"PSJALGDD")
Q
;
DGCKIENX() ;
;Where: PSJDGCK1=STATUS, PSJDGCK2=?, PSJDGCK3=ORDERABLE ITEM, PSJDGCK4=FILE IEN,P PSJDGCK7=DRUG NAME;FILE 50 IEN
N PSJDGCK7 S PSJDGCK7="" I '$D(^TMP("PSJ",$J)) Q PSJDGCK7
I $D(PSJDGCK) D
.N PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6 S (PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6)=""
.S PSJDGCK1=$O(^TMP("PSJ",$J,PSJDGCK1)),PSJDGCK2=$O(^TMP("PSJ",$J,PSJDGCK1,PSJDGCK2)),PSJDGCK3=$O(^TMP("PSJ",$J,PSJDGCK1,PSJDGCK2,PSJDGCK3)),PSJDGCK4=$O(^TMP("PSJ",$J,PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4))
.I PSJDGCK4["U" D K ^TMP($J,"PSJALGDD") Q:$G(PSJDGCKQ)
..D PSS431^PSS55(DFN,+PSJDGCK4,"","","PSJALGDD")
..S PSJDGCK9="",PSJDGCK9=$G(^TMP($J,"PSJALGDD",+PSJDGCK4,"DDRUG",1,.01)) Q:PSJDGCK9=""
..S PSJDGCK7=$P(PSJDGCK9,"^",2)_";"_$P(PSJDGCK9,"^")
..I $P(PSJDGCK7,";",2)'="" S PSJDGCKQ=1
..S PSJDGCK5=$$GET1^DIQ(55.06,+PSJDGCK4_","_DFN_",",108,"I"),PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I"),PSJDGCK7=$$GET1^DIQ(50,$P(PSJDGCK6,";"),.01,"E")
.I PSJDGCK4["V" S PSJDGCK5=$$GET1^DIQ(55.01,+PSJDGCK4_","_DFN_",",130,"I"),PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I"),PSJDGCK7=$$GET1^DIQ(50,$P(PSJDGCK6,";"),.01,"E")
.I PSJDGCK4["P"!(PSJDGCK4["N") S PSJDGCK5=$$GET1^DIQ(53.1,+PSJDGCK4_","_DFN_",",108,"I"),PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I"),PSJDGCK7=$$GET1^DIQ(50,$P(PSJDGCK6,";"),.01,"E")
.S PSJDGCK7=PSJDGCK7_";"_$P(PSJDGCK6,";")
Q PSJDGCK7
;
PSJSUPCK(CHK) ;
I $D(PSGDGCKF) Q 0
I '($P($G(^PSDRUG(CHK,0)),"^",3)["S"!($E($P($G(^PSDRUG(CHK,0)),"^",2),1,2)="XA")) K CHK Q 0
W !,"You have selected a supply item, please select another drug"
W !,"or leave blank and hit enter for Profile Order Checks."
K CHK
Q 1
;
DGCKIEN() ;
;Where: PSJDGCK1=STATUS, PSJDGCK2=?, PSJDGCK3=ORDERABLE ITEM, PSJDGCK4=FILE IEN,P PSJDGCK7=DRUG NAME;FILE 50 IEN
N PSJDGCK7 S PSJDGCK7="" I '$D(^TMP("PSJ",$J)) Q PSJDGCK7
N PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6,PSJDGCK8 S (PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6,PSJDGCK8)="" D
.F S PSJDGCK1=$O(^TMP("PSJ",$J,PSJDGCK1)) Q:PSJDGCK1=""!PSJDGCK8 D
..F S PSJDGCK2=$O(^TMP("PSJ",$J,PSJDGCK1,PSJDGCK2)) Q:PSJDGCK2=""!PSJDGCK8 D
...F S PSJDGCK3=$O(^TMP("PSJ",$J,PSJDGCK1,PSJDGCK2,PSJDGCK3)) Q:PSJDGCK3=""!PSJDGCK8 D
....F S PSJDGCK4=$O(^TMP("PSJ",$J,PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4)) Q:PSJDGCK4=""!PSJDGCK8 D
.....D DGCKIEN2
K PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6,PSJDGCK8
Q PSJDGCK7
;
DGCKIEN2 ;
N PSJDGCK9,PSJDGCKQ
I PSJDGCK4["U" D K ^TMP($J,"PSJALGDD") Q:$G(PSJDGCKQ)
.D PSS431^PSS55(DFN,+PSJDGCK4,"","","PSJALGDD")
.;^TMP(543879344,"PSJALGDD",17,"DDRUG",1,.01)="9116^PENICILLIN GK 20 MILLION UNIT VIAL INJ"
.S PSJDGCK9="",PSJDGCK9=$G(^TMP($J,"PSJALGDD",+PSJDGCK4,"DDRUG",1,.01)) Q:PSJDGCK9=""
.S PSJDGCK7=$P(PSJDGCK9,"^",2)_";"_$P(PSJDGCK9,"^") K ^TMP($J,"PSJALGDD")
.I $P(PSJDGCK7,";",2)'="" S PSJDGCKQ=1 Q
.S PSJDGCK5=$$GET1^DIQ(55.06,+PSJDGCK4_","_DFN_",",108,"I"),PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I"),PSJDGCK7=$$GET1^DIQ(50,$P(PSJDGCK6,";"),.01,"E")
I PSJDGCK4["V" S PSJDGCK5=$$GET1^DIQ(55.01,+PSJDGCK4_","_DFN_",",130,"I"),PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I"),PSJDGCK7=$$GET1^DIQ(50,$P(PSJDGCK6,";"),.01,"E")
I PSJDGCK4["P"!(PSJDGCK4["N") S PSJDGCK5=$$GET1^DIQ(53.1,+PSJDGCK4_","_DFN_",",108,"I"),PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I"),PSJDGCK7=$$GET1^DIQ(50,$P(PSJDGCK6,";"),.01,"E")
S PSJDGCK7=PSJDGCK7_";"_$P(PSJDGCK6,";") I $P(PSJDGCK7,";",2)'=0 S PSJDGCK8=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJDGCK 4053 printed Dec 13, 2024@02:06:41 Page 2
PSJDGCK ;HP/MJE - Drug Interaction Utility ;09/22/11 5:00pm
+1 ;;5.0;INPATIENT MEDICATIONS;**260,288,281**;16 DEC 97;Build 113
+2 ;External references to ^PSSDSAPM supported by DBIA 5570
+3 ;
DGCK ;
+1 SET PSJDGCK=1
SET PSJDGCKX=1
+2 DO FULL^VALM1
+3 IF $DATA(PSJDGCK)&($GET(VALM("TITLE"))="IV Order Entry")
DO EN^PSJO1(2)
+4 IF $$DGCKIEN^PSJDGCK()=""!$PIECE($$DGCKIEN^PSJDGCK(),";",2)=0
Begin DoDot:1
+5 WRITE !!,"Not enough active profile drugs to perform drug check",!
+6 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:1
+7 IF '$TEST
DO ^PSGOE7
DGCKEND SET VALMBCK="R"
+1 KILL PSJDGCK,^TMP($JOB,"PSJALGDD")
+2 QUIT
+3 ;
DGCKIENX() ;
+1 ;Where: PSJDGCK1=STATUS, PSJDGCK2=?, PSJDGCK3=ORDERABLE ITEM, PSJDGCK4=FILE IEN,P PSJDGCK7=DRUG NAME;FILE 50 IEN
+2 NEW PSJDGCK7
SET PSJDGCK7=""
IF '$DATA(^TMP("PSJ",$JOB))
QUIT PSJDGCK7
+3 IF $DATA(PSJDGCK)
Begin DoDot:1
+4 NEW PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6
SET (PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6)=""
+5 SET PSJDGCK1=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1))
SET PSJDGCK2=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1,PSJDGCK2))
SET PSJDGCK3=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1,PSJDGCK2,PSJDGCK3))
SET PSJDGCK4=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4))
+6 IF PSJDGCK4["U"
Begin DoDot:2
+7 DO PSS431^PSS55(DFN,+PSJDGCK4,"","","PSJALGDD")
+8 SET PSJDGCK9=""
SET PSJDGCK9=$GET(^TMP($JOB,"PSJALGDD",+PSJDGCK4,"DDRUG",1,.01))
if PSJDGCK9=""
QUIT
+9 SET PSJDGCK7=$PIECE(PSJDGCK9,"^",2)_";"_$PIECE(PSJDGCK9,"^")
+10 IF $PIECE(PSJDGCK7,";",2)'=""
SET PSJDGCKQ=1
+11 SET PSJDGCK5=$$GET1^DIQ(55.06,+PSJDGCK4_","_DFN_",",108,"I")
SET PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I")
SET PSJDGCK7=$$GET1^DIQ(50,$PIECE(PSJDGCK6,";"),.01,"E")
End DoDot:2
KILL ^TMP($JOB,"PSJALGDD")
if $GET(PSJDGCKQ)
QUIT
+12 IF PSJDGCK4["V"
SET PSJDGCK5=$$GET1^DIQ(55.01,+PSJDGCK4_","_DFN_",",130,"I")
SET PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I")
SET PSJDGCK7=$$GET1^DIQ(50,$PIECE(PSJDGCK6,";"),.01,"E")
+13 IF PSJDGCK4["P"!(PSJDGCK4["N")
SET PSJDGCK5=$$GET1^DIQ(53.1,+PSJDGCK4_","_DFN_",",108,"I")
SET PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I")
SET PSJDGCK7=$$GET1^DIQ(50,$PIECE(PSJDGCK6,";"),.01,"E")
+14 SET PSJDGCK7=PSJDGCK7_";"_$PIECE(PSJDGCK6,";")
End DoDot:1
+15 QUIT PSJDGCK7
+16 ;
PSJSUPCK(CHK) ;
+1 IF $DATA(PSGDGCKF)
QUIT 0
+2 IF '($PIECE($GET(^PSDRUG(CHK,0)),"^",3)["S"!($EXTRACT($PIECE($GET(^PSDRUG(CHK,0)),"^",2),1,2)="XA"))
KILL CHK
QUIT 0
+3 WRITE !,"You have selected a supply item, please select another drug"
+4 WRITE !,"or leave blank and hit enter for Profile Order Checks."
+5 KILL CHK
+6 QUIT 1
+7 ;
DGCKIEN() ;
+1 ;Where: PSJDGCK1=STATUS, PSJDGCK2=?, PSJDGCK3=ORDERABLE ITEM, PSJDGCK4=FILE IEN,P PSJDGCK7=DRUG NAME;FILE 50 IEN
+2 NEW PSJDGCK7
SET PSJDGCK7=""
IF '$DATA(^TMP("PSJ",$JOB))
QUIT PSJDGCK7
+3 NEW PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6,PSJDGCK8
SET (PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6,PSJDGCK8)=""
Begin DoDot:1
+4 FOR
SET PSJDGCK1=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1))
if PSJDGCK1=""!PSJDGCK8
QUIT
Begin DoDot:2
+5 FOR
SET PSJDGCK2=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1,PSJDGCK2))
if PSJDGCK2=""!PSJDGCK8
QUIT
Begin DoDot:3
+6 FOR
SET PSJDGCK3=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1,PSJDGCK2,PSJDGCK3))
if PSJDGCK3=""!PSJDGCK8
QUIT
Begin DoDot:4
+7 FOR
SET PSJDGCK4=$ORDER(^TMP("PSJ",$JOB,PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4))
if PSJDGCK4=""!PSJDGCK8
QUIT
Begin DoDot:5
+8 DO DGCKIEN2
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 KILL PSJDGCK1,PSJDGCK2,PSJDGCK3,PSJDGCK4,PSJDGCK5,PSJDGCK6,PSJDGCK8
+10 QUIT PSJDGCK7
+11 ;
DGCKIEN2 ;
+1 NEW PSJDGCK9,PSJDGCKQ
+2 IF PSJDGCK4["U"
Begin DoDot:1
+3 DO PSS431^PSS55(DFN,+PSJDGCK4,"","","PSJALGDD")
+4 ;^TMP(543879344,"PSJALGDD",17,"DDRUG",1,.01)="9116^PENICILLIN GK 20 MILLION UNIT VIAL INJ"
+5 SET PSJDGCK9=""
SET PSJDGCK9=$GET(^TMP($JOB,"PSJALGDD",+PSJDGCK4,"DDRUG",1,.01))
if PSJDGCK9=""
QUIT
+6 SET PSJDGCK7=$PIECE(PSJDGCK9,"^",2)_";"_$PIECE(PSJDGCK9,"^")
KILL ^TMP($JOB,"PSJALGDD")
+7 IF $PIECE(PSJDGCK7,";",2)'=""
SET PSJDGCKQ=1
QUIT
+8 SET PSJDGCK5=$$GET1^DIQ(55.06,+PSJDGCK4_","_DFN_",",108,"I")
SET PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I")
SET PSJDGCK7=$$GET1^DIQ(50,$PIECE(PSJDGCK6,";"),.01,"E")
End DoDot:1
KILL ^TMP($JOB,"PSJALGDD")
if $GET(PSJDGCKQ)
QUIT
+9 IF PSJDGCK4["V"
SET PSJDGCK5=$$GET1^DIQ(55.01,+PSJDGCK4_","_DFN_",",130,"I")
SET PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I")
SET PSJDGCK7=$$GET1^DIQ(50,$PIECE(PSJDGCK6,";"),.01,"E")
+10 IF PSJDGCK4["P"!(PSJDGCK4["N")
SET PSJDGCK5=$$GET1^DIQ(53.1,+PSJDGCK4_","_DFN_",",108,"I")
SET PSJDGCK6=$$DRG^PSSDSAPM(+PSJDGCK5,"I")
SET PSJDGCK7=$$GET1^DIQ(50,$PIECE(PSJDGCK6,";"),.01,"E")
+11 SET PSJDGCK7=PSJDGCK7_";"_$PIECE(PSJDGCK6,";")
IF $PIECE(PSJDGCK7,";",2)'=0
SET PSJDGCK8=1
QUIT
+12 QUIT
