PSOCPPRE ;BIR/SAB - enhanced dup drug checker for copy orders ;09/21/06 11:34am
;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13
;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
;External references to ^ORRDI1 controlled subscription supported by DBIA 4659
;External references to ^XTMP("ORRDI" supported by DBIA 4660
;External references to ^PSSHRQ2 supported by DBIA 5369
S LIST="PSOPEP",$P(PSONULN,"-",79)="-",(STA,DNM)="" N PSODLQT
F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D Q:$G(PSORX("DFLG"))
.I STA="PENDING" D ^PSODDPR1 Q
.I STA="ZNONVA" D NVA^PSODDPR1 Q
.D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG"))
..I $P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG"))
..I $P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG"))
..I '$P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG"))
.D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP^PSODDPRE
Q:$G(PSORX("DFLG"))
D HD^PSODDPR2():(($Y+5)'>IOSL)
D REMOTE
Q
OBX S LIST="PSOPEPS"
K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD
K HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
K DIR I $P(^TMP($J,LIST,"OUT",0),"^")=-1 G EXIT
K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","DRUGDRUG"),^TMP($J,LIST,"OUT","THERAPY")
W !,"Now Processing Enhanced Order Checks! Please wait...",! H 2
D FDB^PSODDPRE S PDRG=PSODRUG("IEN"),DO=0 D REMOTE^PSODDPR4
D IN^PSSHRQ2(LIST) ;if patient has meds
;
K DIR
I $P(^TMP($J,LIST,"OUT",0),"^")=-1 D DATACK^PSODDPRE G EXIT
D ^PSODDPR2 ;if order checks returned
;
EXIT ;
I $G(PSODLQT)!$G(PSORX("DFLG")) S PSODOSD=1
D ^PSOBUILD K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","DRUGDRUG"),^TMP($J,LIST,"OUT","THERAPY"),^TMP($J,"PSOPEPS"),^TMP($J,"PSORDI")
K DO,LIST,DNM,PSONULN,PSORX("DFLG"),RXRECCOP,STA,Y,PSODLQT
K HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
S VALMBCK="R"
Q
ULRX ;
I '$G(RXRECCOP) Q
D PSOUL^PSSLOCK(RXRECCOP)
Q
;
REMOTE ;
I $T(HAVEHDR^ORRDI1)']"" Q
I '$$HAVEHDR^ORRDI1 Q
I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2
D HD^PSODDPR2():(($Y+5)'>IOSL)
W !!,"Now doing remote order checks. Please wait...",!
D REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN"))
D HD^PSODDPR2():(($Y+5)'>IOSL)
I '$D(^XUSEC("PSORPH",DUZ)),$P(PSOPAR,"^",2),$G(PSOTECCK) G REMOTE2
I $D(^TMP($J,"DD")) D DUP^PSOORRD2
REMOTE2 ;
K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPPRE 2691 printed Oct 16, 2024@18:26:41 Page 2
PSOCPPRE ;BIR/SAB - enhanced dup drug checker for copy orders ;09/21/06 11:34am
+1 ;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13
+2 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
+3 ;External references to ^ORRDI1 controlled subscription supported by DBIA 4659
+4 ;External references to ^XTMP("ORRDI" supported by DBIA 4660
+5 ;External references to ^PSSHRQ2 supported by DBIA 5369
+6 SET LIST="PSOPEP"
SET $PIECE(PSONULN,"-",79)="-"
SET (STA,DNM)=""
NEW PSODLQT
+7 FOR
SET STA=$ORDER(PSOSD(STA))
if STA=""
QUIT
FOR
SET DNM=$ORDER(PSOSD(STA,DNM))
if DNM=""
QUIT
Begin DoDot:1
+8 IF STA="PENDING"
DO ^PSODDPR1
QUIT
+9 IF STA="ZNONVA"
DO NVA^PSODDPR1
QUIT
+10 if PSODRUG("NAME")=$PIECE(DNM,"^")&('$DATA(^XUSEC("PSORPH",DUZ)))
Begin DoDot:2
+11 IF $PIECE($GET(PSOPAR),"^",16)
DO DUP^PSODDPRE
if $GET(PSORX("DFLG"))
QUIT
+12 IF $PIECE(PSOPAR,"^",2)
IF '$PIECE($GET(PSOPAR),"^",16)
DO DUP^PSODDPRE
if $GET(PSORX("DFLG"))
QUIT
+13 IF '$PIECE(PSOPAR,"^",2)
IF '$PIECE($GET(PSOPAR),"^",16)
DO DUP^PSODDPRE
if $GET(PSORX("DFLG"))
QUIT
End DoDot:2
if $GET(PSORX("DFLG"))
QUIT
+14 if PSODRUG("NAME")=$PIECE(DNM,"^")&($DATA(^XUSEC("PSORPH",DUZ)))
DO DUP^PSODDPRE
End DoDot:1
if $GET(PSORX("DFLG"))
QUIT
+15 if $GET(PSORX("DFLG"))
QUIT
+16 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
+17 DO REMOTE
+18 QUIT
OBX SET LIST="PSOPEPS"
+1 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI"),PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD
+2 KILL HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
+3 KILL DIR
IF $PIECE(^TMP($JOB,LIST,"OUT",0),"^")=-1
GOTO EXIT
+4 KILL ^TMP($JOB,LIST,"IN","PING"),^TMP($JOB,LIST,"OUT","DRUGDRUG"),^TMP($JOB,LIST,"OUT","THERAPY")
+5 WRITE !,"Now Processing Enhanced Order Checks! Please wait...",!
HANG 2
+6 DO FDB^PSODDPRE
SET PDRG=PSODRUG("IEN")
SET DO=0
DO REMOTE^PSODDPR4
+7 ;if patient has meds
DO IN^PSSHRQ2(LIST)
+8 ;
+9 KILL DIR
+10 IF $PIECE(^TMP($JOB,LIST,"OUT",0),"^")=-1
DO DATACK^PSODDPRE
GOTO EXIT
+11 ;if order checks returned
DO ^PSODDPR2
+12 ;
EXIT ;
+1 IF $GET(PSODLQT)!$GET(PSORX("DFLG"))
SET PSODOSD=1
+2 DO ^PSOBUILD
KILL CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
+3 KILL ^TMP($JOB,LIST,"IN","PING"),^TMP($JOB,LIST,"OUT","DRUGDRUG"),^TMP($JOB,LIST,"OUT","THERAPY"),^TMP($JOB,"PSOPEPS"),^TMP($JOB,"PSORDI")
+4 KILL DO,LIST,DNM,PSONULN,PSORX("DFLG"),RXRECCOP,STA,Y,PSODLQT
+5 KILL HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT
+6 SET VALMBCK="R"
+7 QUIT
ULRX ;
+1 IF '$GET(RXRECCOP)
QUIT
+2 DO PSOUL^PSSLOCK(RXRECCOP)
+3 QUIT
+4 ;
REMOTE ;
+1 IF $TEXT(HAVEHDR^ORRDI1)']""
QUIT
+2 IF '$$HAVEHDR^ORRDI1
QUIT
+3 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
GOTO REMOTE2
+4 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
+5 WRITE !!,"Now doing remote order checks. Please wait...",!
+6 DO REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN"))
+7 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
+8 IF '$DATA(^XUSEC("PSORPH",DUZ))
IF $PIECE(PSOPAR,"^",2)
IF $GET(PSOTECCK)
GOTO REMOTE2
+9 IF $DATA(^TMP($JOB,"DD"))
DO DUP^PSOORRD2
REMOTE2 ;
+1 KILL ^TMP($JOB,"DD"),^TMP($JOB,"DC"),^TMP($JOB,"DI")
+2 QUIT
