PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;08/23/17 19:54
;;7.0;OUTPATIENT PHARMACY;**132,251,375,387,441**;DEC 1997;Build 208
;External reference ^PS(50.7 - 2223
;External reference ^PS(50.606 - 2174
;External reference ^PSDRUG( - 221
;External reference to ^PS(55 - 2228
EN(PSODFN,ORN,LIST) ;psodfn=patient's ifn, orn=ordertype;order#;drugtype;counter
N DUPRXO,I,ISSD,J,BSIG,RFLS,RXREC,ST,PSONULN,LSTFL
S $P(PSONULN,"-",79)="-"
I $P(ORN,";")="O" G RX
I $P(ORN,";")="P" G PND
I $P(ORN,";")="N" G NVA
I $P(ORN,";")="R" G RDI
Q
RX ;Rx info
Q:'$D(^PSRX($P(ORN,";",2),0)) N ISSD,LSTFLD S RXREC=$P(ORN,";",2)
S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),ISSD=$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3)
S LSTFL=(+^PSRX(RXREC,3)),LSTFL=$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3),RX0=DUPRX0,RX2=^PSRX(RXREC,2)
S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED BY PROVIDER^DISCONTINUED (EDIT)^HELD BY PROVIDER"
S ST=$P(STA,"^",(+$P(^PSRX(RXREC,"STA"),"^")+1)) D K STA ;441 PAPI
. I ST="ACTIVE",$G(^PSRX(RXREC,"PARK")) S ST="PARKED"
W !,"Local Rx #"_$P(DUPRX0,"^")_" ("_ST_") for "_$P(^PSDRUG($P(DUPRX0,"^",6),0),"^")
K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,60) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV)
K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,60)
W !,"SIG: "_$G(BSIG(1)) I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?20,$G(BSIG(PSREV))
D PRSTAT(RXREC) W !
Q
PND ;op pending orders
Q:'$D(^PS(52.41,$P(ORN,";",2),0))
N DUPRX0,FSIG
S DUPRX0=^PS(52.41,$P(ORN,";",2),0)
W !,"Pending Outpatient Drug for "_$S('$P(DUPRX0,"^",9):$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"))
D FSIG^PSOUTLA("P",$P(ORN,";",2),IOM-6)
W !,"SIG: " F I=0:0 S I=$O(FSIG(I)) Q:'I W FSIG(I),!?5
Q
NVA ;non-va meds
Q:'$D(^PS(55,PSODFN,"NVA",$P(ORN,";",2),0))
S DUPRX0=^PS(55,PSODFN,"NVA",$P(ORN,";",2),0)
W !,"NON-VA Med: "_$S('$P(DUPRX0,"^",2):$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",2),0),"^")) ;_" (ACTIVE)"
W !,"Dosage: "_$P(DUPRX0,"^",3),?25,"Schedule: "_$P(DUPRX0,"^",5)
W !
;W !?3,"Date Documented: "_$E($P(DUPRX0,"^",10),4,5)_"/"_$E($P(DUPRX0,"^",10),6,7)_"/"_$E($P(DUPRX0,"^",10),2,3),?30,"Status: Active",!
K DUPRX0
Q
RDI ;RDI orders
Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2)))
S RXREC=^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2))
W !,"LOCATION: "_$P(RXREC,"^")
W !,"Remote Rx #"_$P(RXREC,"^",5)_" ("_$P(RXREC,"^",4)_") for "_$P(RXREC,"^",3)
W !,"SIG: " S I="" F S I=$O(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I)) Q:I="" D
.W ^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I),!
.I $O(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I))'="" W ?5
W "Last Filled On: "_$P(RXREC,"^",6),!
K RXREC,I
Q
PRSTAT(DA) ;Displays the prescription's status
N PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP
D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13)
D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL
.S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3)
.S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18))
.S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4)
.I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS
.I $P($G(^PSRX(RXREC,"STA")),"^")=0 W:$$TRANCMOP^PSOUTL(RXREC) ?5,IORVON_IOINHI
.W !,RXPSTA_$S($P(PSOCMOP,"^")=0!($P(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$P(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF
D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
I $G(PSOCMOP)']"" D
.F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D
..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0))
..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16)
.I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15)
.W !,RXPSTA I +$G(PSORTS) W "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2) Q
.W $S(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($P(PSOLRD,"^"),2)_" "_$P(PSOLRD,"^",2))_$S($P(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODRDU2 4612 printed Apr 09, 2024@21:28:53 Page 2
PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;08/23/17 19:54
+1 ;;7.0;OUTPATIENT PHARMACY;**132,251,375,387,441**;DEC 1997;Build 208
+2 ;External reference ^PS(50.7 - 2223
+3 ;External reference ^PS(50.606 - 2174
+4 ;External reference ^PSDRUG( - 221
+5 ;External reference to ^PS(55 - 2228
EN(PSODFN,ORN,LIST) ;psodfn=patient's ifn, orn=ordertype;order#;drugtype;counter
+1 NEW DUPRXO,I,ISSD,J,BSIG,RFLS,RXREC,ST,PSONULN,LSTFL
+2 SET $PIECE(PSONULN,"-",79)="-"
+3 IF $PIECE(ORN,";")="O"
GOTO RX
+4 IF $PIECE(ORN,";")="P"
GOTO PND
+5 IF $PIECE(ORN,";")="N"
GOTO NVA
+6 IF $PIECE(ORN,";")="R"
GOTO RDI
+7 QUIT
RX ;Rx info
+1 if '$DATA(^PSRX($PIECE(ORN,";",2),0))
QUIT
NEW ISSD,LSTFLD
SET RXREC=$PIECE(ORN,";",2)
+2 SET DUPRX0=^PSRX(RXREC,0)
SET RFLS=$PIECE(DUPRX0,"^",9)
SET ISSD=$PIECE(^PSRX(RXREC,0),"^",13)
SET ISSD=$EXTRACT(ISSD,4,5)_"/"_$EXTRACT(ISSD,6,7)_"/"_$EXTRACT(ISSD,2,3)
+3 SET LSTFL=(+^PSRX(RXREC,3))
SET LSTFL=$EXTRACT(LSTFL,4,5)_"/"_$EXTRACT(LSTFL,6,7)_"/"_$EXTRACT(LSTFL,2,3)
SET RX0=DUPRX0
SET RX2=^PSRX(RXREC,2)
+4 SET STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED BY PROVIDER^DISCONTINUED (EDIT)^HELD BY PROVIDER"
+5 ;441 PAPI
SET ST=$PIECE(STA,"^",(+$PIECE(^PSRX(RXREC,"STA"),"^")+1))
Begin DoDot:1
+6 IF ST="ACTIVE"
IF $GET(^PSRX(RXREC,"PARK"))
SET ST="PARKED"
End DoDot:1
KILL STA
+7 WRITE !,"Local Rx #"_$PIECE(DUPRX0,"^")_" ("_ST_") for "_$PIECE(^PSDRUG($PIECE(DUPRX0,"^",6),0),"^")
+8 KILL FSIG,BSIG
IF $PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO FSIG^PSOUTLA("R",RXREC,60)
FOR PSREV=1:1
if '$DATA(FSIG(PSREV))
QUIT
SET BSIG(PSREV)=FSIG(PSREV)
+9 KILL FSIG,PSREV
IF '$PIECE($GET(^PSRX(RXREC,"SIG")),"^",2)
DO EN2^PSOUTLA1(RXREC,60)
+10 WRITE !,"SIG: "_$GET(BSIG(1))
IF $ORDER(BSIG(1))
FOR PSREV=1:0
SET PSREV=$ORDER(BSIG(PSREV))
if 'PSREV
QUIT
WRITE !?20,$GET(BSIG(PSREV))
+11 DO PRSTAT(RXREC)
WRITE !
+12 QUIT
PND ;op pending orders
+1 if '$DATA(^PS(52.41,$PIECE(ORN,";",2),0))
QUIT
+2 NEW DUPRX0,FSIG
+3 SET DUPRX0=^PS(52.41,$PIECE(ORN,";",2),0)
+4 WRITE !,"Pending Outpatient Drug for "_$SELECT('$PIECE(DUPRX0,"^",9):$PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"),1:$PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^"))
+5 DO FSIG^PSOUTLA("P",$PIECE(ORN,";",2),IOM-6)
+6 WRITE !,"SIG: "
FOR I=0:0
SET I=$ORDER(FSIG(I))
if 'I
QUIT
WRITE FSIG(I),!?5
+7 QUIT
NVA ;non-va meds
+1 if '$DATA(^PS(55,PSODFN,"NVA",$PIECE(ORN,";",2),0))
QUIT
+2 SET DUPRX0=^PS(55,PSODFN,"NVA",$PIECE(ORN,";",2),0)
+3 ;_" (ACTIVE)"
WRITE !,"NON-VA Med: "_$SELECT('$PIECE(DUPRX0,"^",2):$PIECE(^PS(50.7,$PIECE(DUPRX0,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^"),1:$PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^"))
+4 WRITE !,"Dosage: "_$PIECE(DUPRX0,"^",3),?25,"Schedule: "_$PIECE(DUPRX0,"^",5)
+5 WRITE !
+6 ;W !?3,"Date Documented: "_$E($P(DUPRX0,"^",10),4,5)_"/"_$E($P(DUPRX0,"^",10),6,7)_"/"_$E($P(DUPRX0,"^",10),2,3),?30,"Status: Active",!
+7 KILL DUPRX0
+8 QUIT
RDI ;RDI orders
+1 if '$DATA(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2)))
QUIT
+2 SET RXREC=^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2))
+3 WRITE !,"LOCATION: "_$PIECE(RXREC,"^")
+4 WRITE !,"Remote Rx #"_$PIECE(RXREC,"^",5)_" ("_$PIECE(RXREC,"^",4)_") for "_$PIECE(RXREC,"^",3)
+5 WRITE !,"SIG: "
SET I=""
FOR
SET I=$ORDER(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2),"SIG",I))
if I=""
QUIT
Begin DoDot:1
+6 WRITE ^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2),"SIG",I),!
+7 IF $ORDER(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ORN,";",2),"SIG",I))'=""
WRITE ?5
End DoDot:1
+8 WRITE "Last Filled On: "_$PIECE(RXREC,"^",6),!
+9 KILL RXREC,I
+10 QUIT
PRSTAT(DA) ;Displays the prescription's status
+1 NEW PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP
+2 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
SET RXPSTA="Processing Status: "
SET PSOLRD=$PIECE($GET(^PSRX(RXREC,2)),"^",13)
+3 DO ^PSOCMOPA
IF $GET(PSOCMOP)]""
Begin DoDot:1
+4 SET PSOTRANS=$EXTRACT($PIECE(PSOCMOP,"^",2),4,5)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),6,7)_"/"_$EXTRACT($PIECE(PSOCMOP,"^",2),2,3)
+5 SET PSOREL=$SELECT(CMOP("L")=0:$PIECE($GET(^PSRX(DA,2)),"^",13),1:$PIECE(^PSRX(DA,1,CMOP("L"),0),"^",18))
+6 SET PSOREL=$EXTRACT(PSOREL,4,5)_"/"_$EXTRACT(PSOREL,6,7)_"/"_$EXTRACT(PSOREL,2,3)_"@"_$EXTRACT($PIECE(PSOREL,".",2),1,4)
+7 IF '$DATA(IOINORM)!('$DATA(IOINHI))
SET X="IORVOFF;IORVON;IOINHI;IOINORM"
DO ENDR^%ZISS
+8 IF $PIECE($GET(^PSRX(RXREC,"STA")),"^")=0
if $$TRANCMOP^PSOUTL(RXREC)
WRITE ?5,IORVON_IOINHI
+9 WRITE !,RXPSTA_$SELECT($PIECE(PSOCMOP,"^")=0!($PIECE(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$PIECE(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF
End DoDot:1
KILL CMOP,PSOTRANS,PSOREL
+10 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+11 IF $GET(PSOCMOP)']""
Begin DoDot:1
+12 FOR PSOX=0:0
SET PSOX=$ORDER(^PSRX(RXREC,1,PSOX))
if 'PSOX
QUIT
Begin DoDot:2
+13 SET RFLZRO=$GET(^PSRX(RXREC,1,PSOX,0))
+14 if $PIECE(RFLZRO,"^",18)'=""
SET PSOLRD=$PIECE(RFLZRO,"^",18)
IF $PIECE(RFLZRO,"^",16)
SET PSOLRD=PSOLRD_"^R"
SET PSORTS=$PIECE(RFLZRO,"^",16)
End DoDot:2
+15 IF '$ORDER(^PSRX(RXREC,1,0))
IF $PIECE(^PSRX(RXREC,2),"^",15)
SET PSOLRD=PSOLRD_"^R"
SET PSORTS=$PIECE(^PSRX(RXREC,2),"^",15)
+16 WRITE !,RXPSTA
IF +$GET(PSORTS)
WRITE "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2)
QUIT
+17 WRITE $SELECT(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($PIECE(PSOLRD,"^"),2)_" "_$PIECE(PSOLRD,"^",2))_$SELECT($PIECE(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)")
End DoDot:1
+18 QUIT
