PSOORRD2.m

PSOORRD2 ;BHAM-ISC/EJW - Remote Data Interoperabilty Order Checks - backdoor ;06/26/05

 ;;7.0;OUTPATIENT PHARMACY;**207**;DEC 1997

 ;

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 ",$P(PSOD1,"^")," in Remote Prescription",!

 .W ">> ",RDIINST,!

 .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

 ;

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)="EA",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 Activate medication",DIR("?")="      '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

PSOORRD2  ;BHAM-ISC/EJW - Remote Data Interoperabilty Order Checks - backdoor ;06/26/05

 +1       ;;7.0;OUTPATIENT PHARMACY;**207**;DEC 1997

 +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 ",$PIECE(PSOD1,"^")," in Remote Prescription",!

 +6                WRITE ">> ",RDIINST,!

 +7                WRITE $JUSTIFY("Rx #: ",20)_$EXTRACT(PSOREMX,1,$LENGTH(PSOREMX)-1),!

 +8                WRITE $JUSTIFY("Status: ",20),$PIECE(PSOD1,"^",2)

 +9                WRITE ?44,$JUSTIFY("Issued: ",20),$PIECE(PSOD1,"^",9)

 +10               DO FSIG(.FSIG)

 +11               WRITE !,$JUSTIFY("SIG: ",20)

                   FOR I=1:1

                       IF '$DATA(FSIG(I))

                           QUIT 

                       WRITE ?20,FSIG(I),!

 +12               WRITE $JUSTIFY("QTY: ",20),$PIECE(PSOD1,"^",5),!

 +13               WRITE $JUSTIFY("Provider: ",20),$PIECE(PSOD1,"^",8)

 +14               WRITE ?44,$JUSTIFY("Refills remaining: ",20),$PIECE(PSOD1,"^",6)

 +15               WRITE !?44,$JUSTIFY("Last filled on: ",20),PSOLF

 +16               WRITE !?44,$JUSTIFY("Days Supply: ",20),$PIECE(PSOD1,"^",4)

 +17               DO PAUSE

               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)="EA"

           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 Activate medication"

           SET DIR("?")="      '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