Routine: PSSDIUTX

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDIUTX   1121     printed  Apr 09, 2024@21:34:30                                                                                                                                                                                                    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

PSSDIUTX.m