- 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 Feb 18, 2025@23:56:56 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