PSSDIUTX ;HP/MJE - Drug Interaction Utility ;05/14/11 5:00pm
;;1.0;PHARMACY DATA MANAGEMENT;**175**;9/30/97;Build 9
;This routine can be used for PSS namespace additional code
;
DELDISC ;This will delete discontinued drugs from drug interaction order checks result set but not dup therapy results
I $D(PSOSD("DISCONTINUED")) D
.N CKSV,CKDRG,CKON,CKCT,CKVAL,CKNM,DCRCMN S (CKSV,CKDRG,CKON,CKCT,CKVAL,CKNM,DCRCMN)=""
.F S CKNM=$O(PSOSD("DISCONTINUED",CKNM)) Q:CKNM="" D
..S DCRCNM=$P(PSOSD("DISCONTINUED",CKNM),"^") D
...F S CKSV=$O(^TMP($J,LIST,"OUT","DRUGDRUG",CKSV)) Q:CKSV="" F S CKDRG=$O(^TMP($J,LIST,"OUT","DRUGDRUG",CKSV,CKDRG)) Q:CKDRG="" D
....F S CKON=$O(^TMP($J,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON)) Q:CKON="" F S CKCT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT)) Q:CKCT="" D
.....S CKVAL=$P($P(^TMP($J,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT),"^"),";",2)
.....I DCRCNM=CKVAL K ^TMP($J,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT)
.....I DCRCNM=$P(CKON,";",2) K ^TMP($J,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT)
K CKSV,CKDRG,CKON,CKCT,CKVAL,CKNM,DCRCMN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDIUTX 1121 printed Nov 22, 2024@17:40:55 Page 2
PSSDIUTX ;HP/MJE - Drug Interaction Utility ;05/14/11 5:00pm
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**175**;9/30/97;Build 9
+2 ;This routine can be used for PSS namespace additional code
+3 ;
DELDISC ;This will delete discontinued drugs from drug interaction order checks result set but not dup therapy results
+1 IF $DATA(PSOSD("DISCONTINUED"))
Begin DoDot:1
+2 NEW CKSV,CKDRG,CKON,CKCT,CKVAL,CKNM,DCRCMN
SET (CKSV,CKDRG,CKON,CKCT,CKVAL,CKNM,DCRCMN)=""
+3 FOR
SET CKNM=$ORDER(PSOSD("DISCONTINUED",CKNM))
if CKNM=""
QUIT
Begin DoDot:2
+4 SET DCRCNM=$PIECE(PSOSD("DISCONTINUED",CKNM),"^")
Begin DoDot:3
+5 FOR
SET CKSV=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV))
if CKSV=""
QUIT
FOR
SET CKDRG=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV,CKDRG))
if CKDRG=""
QUIT
Begin DoDot:4
+6 FOR
SET CKON=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON))
if CKON=""
QUIT
FOR
SET CKCT=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT))
if CKCT=""
QUIT
Begin DoDot:5
+7 SET CKVAL=$PIECE($PIECE(^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT),"^"),";",2)
+8 IF DCRCNM=CKVAL
KILL ^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT)
+9 IF DCRCNM=$PIECE(CKON,";",2)
KILL ^TMP($JOB,LIST,"OUT","DRUGDRUG",CKSV,CKDRG,CKON,CKCT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 KILL CKSV,CKDRG,CKON,CKCT,CKVAL,CKNM,DCRCMN
+11 QUIT
