source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORRD2.m@ 636

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