PSOORRD2 ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks - backdoor ;06/26/05
;;7.0;OUTPATIENT PHARMACY;**207,251,387,372**;DEC 1997;Build 54
;
DUP ;Remote order - duplicate drug
N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI
S $P(PSOULN,"-",79)="",PSOT="DD"
S PSORDI=0 F S PSORDI=$O(^TMP($J,"DD",PSORDI)) Q:'PSORDI S PSOD0=^TMP($J,"DD",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",4),";"),RDIINST=$P(PSOD0,"^",5),PSOLF=$P(PSOD1,"^",3) D
.W !,PSOULN,!
.W "Duplicate Drug in Remote Rx:",!
.W $J("Location Name: ",20)_RDIINST,!
.W $J("Rx #: ",20)_$E(PSOREMX,1,$L(PSOREMX)-1),!
.W $J("Drug: ",20)_$P(PSOD1,"^"),!
.D FSIG(.FSIG)
.W $J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
.W $J("QTY: ",20)_$P(PSOD1,"^",5),?44,$J("Refills remaining: ",20)_$P(PSOD1,"^",6)
.W !,$J("Provider: ",20)_$P(PSOD1,"^",8),?44,$J("Issued: ",20)_$P(PSOD1,"^",9)
.W !,$J("Status: ",20)_$P(PSOD1,"^",2),?44,$J("Last filled on: ",20)_PSOLF
.W !?44,$J("Days Supply: ",20)_$P(PSOD1,"^",4)
.W !,PSOULN,!
.D PAUSE
.S ^TMP($J,"PSORMDD",PSORDI,0)=1
K PSOT
Q
;
CLS ;Remote order - duplicate drug class
N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI
S $P(PSOULN,"-",79)="",PSOT="DC"
S PSORDI=0 F S PSORDI=$O(^TMP($J,"DC",PSORDI)) Q:'PSORDI S PSOD0=^TMP($J,"DC",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",6),";"),RDIINST=$P(PSOD0,"^",7),PSOLF=$P(PSOD1,"^",3) D
.W !,PSOULN,!
.W " *** SAME CLASS *** OF DRUG IN REMOTE RX FOR ",$P(PSOD1,"^"),!
.W ">> ",RDIINST,!
.W "CLASS: ",$P(PSOD0,"^"),!
.W $J("Rx #: ",20)_$E(PSOREMX,1,$L(PSOREMX)-1),!
.W $J("Status: ",20),$P(PSOD1,"^",2)
.W ?44,$J("Issued: ",20),$P(PSOD1,"^",9)
.D FSIG(.FSIG)
.W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
.W $J("QTY: ",20),$P(PSOD1,"^",5),!
.W $J("Provider: ",20),$P(PSOD1,"^",8)
.W ?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6)
.W !?44,$J("Last filled on: ",20),PSOLF
.W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4)
.D PAUSE
K PSOT
Q
FSIG(FSIG) ;Format sig from remote site
;returned in the FSIG array
N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
F I=0:1 Q:'$D(^TMP($J,PSOT,PSORDI,1,I)) S HSIG(I+1)=^(I)
FSTART S (FVAR,FVAR1)="",II=1
F FFF=0:0 S FFF=$O(HSIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(HSIG(FFF)) I $E(HSIG(FFF),NNN)=" "!($L(HSIG(FFF))=NNN) S CNT=CNT+1 D I $L(FVAR)>52 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1
.S FVAR1=$P(HSIG(FFF)," ",(CNT))
.S FLIM=FVAR
.S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
I $G(FVAR)'="" S FSIG(II)=FVAR
I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
FQUIT Q
SIGNIF ;
S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR
I Y I '$D(PSORX("INTERVENE")) S PSORX("INTERVENE")=2
I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q
Q
;
PAUSE ;
K DIR W ! S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue..." D ^DIR W ! K DIR
Q
DRGINT ;DRUG-DRUG INTERACTION WITH ORDER FROM REMOTE SITE
N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSOINT,PSORDI
S $P(PSOULN,"-",79)="",PSOT="DI"
S PSORDI=0 F S PSORDI=$O(^TMP($J,"DI",PSORDI)) Q:'PSORDI Q:$G(PSORX("DFLG")) S PSOD0=^TMP($J,"DI",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",8),";"),RDIINST=$P(PSOD0,"^",9),PSOLF=$P(PSOD1,"^",3) D
.S PSOINT=$P(PSOD0,"^",4)
.W !,PSOULN,!
.W ">> ",RDIINST,!
.W ?5,"** ",PSOINT," ** DRUG-DRUG interaction ",$P(PSOD0,"^",5)," & ",$P(PSOD0,"^",6),!
.W ?5,"Remote RX # ",$E(PSOREMX,1,$L(PSOREMX)-1)," Drug: ",$P(PSOD1,"^"),!
.W $J("Status: ",20),$P(PSOD1,"^",2)
.W ?44,$J("Issued: ",20),$P(PSOD1,"^",9)
.D FSIG(.FSIG)
.W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),!
.W $J("QTY: ",20),$P(PSOD1,"^",5),!
.W $J("Provider: ",20),$P(PSOD1,"^",8)
.W !?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6)
.W !?44,$J("Last filled on: ",20),PSOLF
.W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4)
.I '$D(^XUSEC("PSORPH",DUZ)) Q ; CLERK/TECH ENTRY
.I PSOINT'="CRITICAL" D SIGNIF
.I PSOINT="CRITICAL" D CRI
K PSOT,PSORDI
Q
;
CRI ;process new drug interactions entered by pharmacist
K DIR S DIR("A",1)="",DIR("A",2)="Do you want to Process medication",DIR("A")=PSODRUG("NAME")_": ",DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY",DIR("B")="P"
S DIR("?",1)="Enter '1' or 'P' to Process medication",DIR("?")=" '^' to EXIT",DIR("?",2)=" '0' or 'A' to Abort Order Entry process" D ^DIR K X1,DIR I 'Y S PSORX("DFLG")=1,DGI="" K DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE") Q
D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q
S PSORX("INTERVENE")=1
K DUOUT,DTOUT,DIRUT,DIROUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORRD2 4644 printed Sep 23, 2025@20:08:41 Page 2
PSOORRD2 ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks - backdoor ;06/26/05
+1 ;;7.0;OUTPATIENT PHARMACY;**207,251,387,372**;DEC 1997;Build 54
+2 ;
DUP ;Remote order - duplicate drug
+1 NEW PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI
+2 SET $PIECE(PSOULN,"-",79)=""
SET PSOT="DD"
+3 SET PSORDI=0
FOR
SET PSORDI=$ORDER(^TMP($JOB,"DD",PSORDI))
if 'PSORDI
QUIT
SET PSOD0=^TMP($JOB,"DD",PSORDI,0)
SET PSOD1=^(1)
SET PSOREMX=$PIECE($PIECE(PSOD0,"^",4),";")
SET RDIINST=$PIECE(PSOD0,"^",5)
SET PSOLF=$PIECE(PSOD1,"^",3)
Begin DoDot:1
+4 WRITE !,PSOULN,!
+5 WRITE "Duplicate Drug in Remote Rx:",!
+6 WRITE $JUSTIFY("Location Name: ",20)_RDIINST,!
+7 WRITE $JUSTIFY("Rx #: ",20)_$EXTRACT(PSOREMX,1,$LENGTH(PSOREMX)-1),!
+8 WRITE $JUSTIFY("Drug: ",20)_$PIECE(PSOD1,"^"),!
+9 DO FSIG(.FSIG)
+10 WRITE $JUSTIFY("SIG: ",20)
FOR I=1:1
if '$DATA(FSIG(I))
QUIT
WRITE ?20,FSIG(I),!
+11 WRITE $JUSTIFY("QTY: ",20)_$PIECE(PSOD1,"^",5),?44,$JUSTIFY("Refills remaining: ",20)_$PIECE(PSOD1,"^",6)
+12 WRITE !,$JUSTIFY("Provider: ",20)_$PIECE(PSOD1,"^",8),?44,$JUSTIFY("Issued: ",20)_$PIECE(PSOD1,"^",9)
+13 WRITE !,$JUSTIFY("Status: ",20)_$PIECE(PSOD1,"^",2),?44,$JUSTIFY("Last filled on: ",20)_PSOLF
+14 WRITE !?44,$JUSTIFY("Days Supply: ",20)_$PIECE(PSOD1,"^",4)
+15 WRITE !,PSOULN,!
+16 DO PAUSE
+17 SET ^TMP($JOB,"PSORMDD",PSORDI,0)=1
End DoDot:1
+18 KILL PSOT
+19 QUIT
+20 ;
CLS ;Remote order - duplicate drug class
+1 NEW PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI
+2 SET $PIECE(PSOULN,"-",79)=""
SET PSOT="DC"
+3 SET PSORDI=0
FOR
SET PSORDI=$ORDER(^TMP($JOB,"DC",PSORDI))
if 'PSORDI
QUIT
SET PSOD0=^TMP($JOB,"DC",PSORDI,0)
SET PSOD1=^(1)
SET PSOREMX=$PIECE($PIECE(PSOD0,"^",6),";")
SET RDIINST=$PIECE(PSOD0,"^",7)
SET PSOLF=$PIECE(PSOD1,"^",3)
Begin DoDot:1
+4 WRITE !,PSOULN,!
+5 WRITE " *** SAME CLASS *** OF DRUG IN REMOTE RX FOR ",$PIECE(PSOD1,"^"),!
+6 WRITE ">> ",RDIINST,!
+7 WRITE "CLASS: ",$PIECE(PSOD0,"^"),!
+8 WRITE $JUSTIFY("Rx #: ",20)_$EXTRACT(PSOREMX,1,$LENGTH(PSOREMX)-1),!
+9 WRITE $JUSTIFY("Status: ",20),$PIECE(PSOD1,"^",2)
+10 WRITE ?44,$JUSTIFY("Issued: ",20),$PIECE(PSOD1,"^",9)
+11 DO FSIG(.FSIG)
+12 WRITE !,$JUSTIFY("SIG: ",20)
FOR I=1:1
if '$DATA(FSIG(I))
QUIT
WRITE ?20,FSIG(I),!
+13 WRITE $JUSTIFY("QTY: ",20),$PIECE(PSOD1,"^",5),!
+14 WRITE $JUSTIFY("Provider: ",20),$PIECE(PSOD1,"^",8)
+15 WRITE ?44,$JUSTIFY("Refills remaining: ",20),$PIECE(PSOD1,"^",6)
+16 WRITE !?44,$JUSTIFY("Last filled on: ",20),PSOLF
+17 WRITE !?44,$JUSTIFY("Days Supply: ",20),$PIECE(PSOD1,"^",4)
+18 DO PAUSE
End DoDot:1
+19 KILL PSOT
+20 QUIT
FSIG(FSIG) ;Format sig from remote site
+1 ;returned in the FSIG array
+2 NEW FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
+3 FOR I=0:1
if '$DATA(^TMP($JOB,PSOT,PSORDI,1,I))
QUIT
SET HSIG(I+1)=^(I)
FSTART SET (FVAR,FVAR1)=""
SET II=1
+1 FOR FFF=0:0
SET FFF=$ORDER(HSIG(FFF))
if 'FFF
QUIT
SET CNT=0
FOR NNN=1:1:$LENGTH(HSIG(FFF))
IF $EXTRACT(HSIG(FFF),NNN)=" "!($LENGTH(HSIG(FFF))=NNN)
SET CNT=CNT+1
Begin DoDot:1
+2 SET FVAR1=$PIECE(HSIG(FFF)," ",(CNT))
+3 SET FLIM=FVAR
+4 SET FVAR=$SELECT(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
End DoDot:1
IF $LENGTH(FVAR)>52
SET FSIG(II)=FLIM_" "
SET II=II+1
SET FVAR=FVAR1
+5 IF $GET(FVAR)'=""
SET FSIG(II)=FVAR
+6 IF $GET(FSIG(1))=""!($GET(FSIG(1))=" ")
SET FSIG(1)=$GET(FSIG(2))
KILL FSIG(2)
FQUIT QUIT
SIGNIF ;
+1 SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene? "
SET DIR("B")="Y"
WRITE !
DO ^DIR
+2 IF Y
IF '$DATA(PSORX("INTERVENE"))
SET PSORX("INTERVENE")=2
+3 IF '$GET(Y)
KILL DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y
QUIT
+4 QUIT
+5 ;
PAUSE ;
+1 KILL DIR
WRITE !
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue..."
DO ^DIR
WRITE !
KILL DIR
+2 QUIT
DRGINT ;DRUG-DRUG INTERACTION WITH ORDER FROM REMOTE SITE
+1 NEW PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSOINT,PSORDI
+2 SET $PIECE(PSOULN,"-",79)=""
SET PSOT="DI"
+3 SET PSORDI=0
FOR
SET PSORDI=$ORDER(^TMP($JOB,"DI",PSORDI))
if 'PSORDI
QUIT
if $GET(PSORX("DFLG"))
QUIT
SET PSOD0=^TMP($JOB,"DI",PSORDI,0)
SET PSOD1=^(1)
SET PSOREMX=$PIECE($PIECE(PSOD0,"^",8),";")
SET RDIINST=$PIECE(PSOD0,"^",9)
SET PSOLF=$PIECE(PSOD1,"^",3)
Begin DoDot:1
+4 SET PSOINT=$PIECE(PSOD0,"^",4)
+5 WRITE !,PSOULN,!
+6 WRITE ">> ",RDIINST,!
+7 WRITE ?5,"** ",PSOINT," ** DRUG-DRUG interaction ",$PIECE(PSOD0,"^",5)," & ",$PIECE(PSOD0,"^",6),!
+8 WRITE ?5,"Remote RX # ",$EXTRACT(PSOREMX,1,$LENGTH(PSOREMX)-1)," Drug: ",$PIECE(PSOD1,"^"),!
+9 WRITE $JUSTIFY("Status: ",20),$PIECE(PSOD1,"^",2)
+10 WRITE ?44,$JUSTIFY("Issued: ",20),$PIECE(PSOD1,"^",9)
+11 DO FSIG(.FSIG)
+12 WRITE !,$JUSTIFY("SIG: ",20)
FOR I=1:1
if '$DATA(FSIG(I))
QUIT
WRITE ?20,FSIG(I),!
+13 WRITE $JUSTIFY("QTY: ",20),$PIECE(PSOD1,"^",5),!
+14 WRITE $JUSTIFY("Provider: ",20),$PIECE(PSOD1,"^",8)
+15 WRITE !?44,$JUSTIFY("Refills remaining: ",20),$PIECE(PSOD1,"^",6)
+16 WRITE !?44,$JUSTIFY("Last filled on: ",20),PSOLF
+17 WRITE !?44,$JUSTIFY("Days Supply: ",20),$PIECE(PSOD1,"^",4)
+18 ; CLERK/TECH ENTRY
IF '$DATA(^XUSEC("PSORPH",DUZ))
QUIT
+19 IF PSOINT'="CRITICAL"
DO SIGNIF
+20 IF PSOINT="CRITICAL"
DO CRI
End DoDot:1
+21 KILL PSOT,PSORDI
+22 QUIT
+23 ;
CRI ;process new drug interactions entered by pharmacist
+1 KILL DIR
SET DIR("A",1)=""
SET DIR("A",2)="Do you want to Process medication"
SET DIR("A")=PSODRUG("NAME")_": "
SET DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY"
SET DIR("B")="P"
+2 SET DIR("?",1)="Enter '1' or 'P' to Process medication"
SET DIR("?")=" '^' to EXIT"
SET DIR("?",2)=" '0' or 'A' to Abort Order Entry process"
DO ^DIR
KILL X1,DIR
IF 'Y
SET PSORX("DFLG")=1
SET DGI=""
KILL DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE")
QUIT
+3 DO SIG^XUSESIG
IF X1=""
KILL PSORX("INTERVENE")
SET PSORX("DFLG")=1
QUIT
+4 SET PSORX("INTERVENE")=1
+5 KILL DUOUT,DTOUT,DIRUT,DIROUT
+6 QUIT
