PSORESK1 ;BHAM ISC/SAB - return to stock continued ;06/03/97 10:12
;;7.0;OUTPATIENT PHARMACY;**9,201**;DEC 1997
HP W !!,"Wand the barcode number of the Rx or manually key in",!,"the number below the barcode or the Rx number."
W !,"The barcode number format is - 'NNN-NNNNNNN'",!!,"Press 'ENTER' to process Rx or ""^"" to quit"
Q
STAT S RX0=^PSRX(RXP,0),RX2=^PSRX(RXP,2),J=RXP S $P(RX0,"^",15)=$P($G(^PSRX(RXP,"STA")),"^") D ^PSOFUNC
W !!,$C(7),$C(7),"Rx status of "_ST_" and cannot be returned to stock.",! K RX0,ST Q
CP D NOW^%DTC S PSODT=%
S PSOCPRX=$P(^PSRX(RXP,0),"^") S PSO=1,PSODA=RXP,PSOPAR7=$G(^PS(59,PSOSITE,"IB")) W !!,"Attempting to remove copay charges",! D RXED^PSOCPA
I COPAYFLG=0 W !!,"Reason must be entered. Rx "_$P(^PSRX(RXP,0),"^")_" not returned to stock.",!
;PFS: send Rx info to external billing system when copay and no copay.
Q
ACT S IFN=0 F I=0:0 S I=$O(^PSRX(RXP,"A",I)) Q:'I S IFN=I
I $G(PSOWHERE) S COM=$G(COM)_" (Released by CMOP)"
I +$G(PSOPFS) S:$P(PSOPFS,"^",3)'="" COM=$G(COM)_" (External Billing Charge ID: "_$P(PSOPFS,"^",3)_")"
D NOW^%DTC S IFN=IFN+1,^PSRX(RXP,"A",0)="^52.3DA^"_IFN_"^"_IFN,^PSRX(RXP,"A",IFN,0)=%_"^I^"_DUZ_"^"_$S(XTYPE="O":0,$G(TYPE)'<0&($G(TYPE)<6)&(XTYPE):TYPE,$G(TYPE)>5&(XTYPE):(TYPE+1),1:6)_"^"_COM
K DA Q
CMOP ;original released by CMOP? Called by PSORESK
S PSXREL=$P($G(^PSRX(RXP,2)),"^",13)
I $G(PSXREL),($D(^PSRX("AR",PSXREL,RXP,0))) W !!,$C(7),"Rx # "_$P(^PSRX(RXP,0),"^")_":",?20," Was dispensed by the CMOP and may not be returned"
I W !,?20," to stock at this facility." Q
K PSXREL
Q
CMOP1 ; REFILL released by CMOP? Called by PSORESK
I +$G(XTYPE) S PSXREL=$P($G(^PSRX(RXP,1,TYPE,0)),"^",18)
I $G(PSXREL),($D(^PSRX("AR",PSXREL,RXP,TYPE))) W !!,"REFILL # "_TYPE_":",?20," Was dispensed by the CMOP and may not be returned"
I W !,?20," to stock at this facility." Q
K PSXREL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORESK1 1898 printed Oct 16, 2024@18:34:29 Page 2
PSORESK1 ;BHAM ISC/SAB - return to stock continued ;06/03/97 10:12
+1 ;;7.0;OUTPATIENT PHARMACY;**9,201**;DEC 1997
HP WRITE !!,"Wand the barcode number of the Rx or manually key in",!,"the number below the barcode or the Rx number."
+1 WRITE !,"The barcode number format is - 'NNN-NNNNNNN'",!!,"Press 'ENTER' to process Rx or ""^"" to quit"
+2 QUIT
STAT SET RX0=^PSRX(RXP,0)
SET RX2=^PSRX(RXP,2)
SET J=RXP
SET $PIECE(RX0,"^",15)=$PIECE($GET(^PSRX(RXP,"STA")),"^")
DO ^PSOFUNC
+1 WRITE !!,$CHAR(7),$CHAR(7),"Rx status of "_ST_" and cannot be returned to stock.",!
KILL RX0,ST
QUIT
CP DO NOW^%DTC
SET PSODT=%
+1 SET PSOCPRX=$PIECE(^PSRX(RXP,0),"^")
SET PSO=1
SET PSODA=RXP
SET PSOPAR7=$GET(^PS(59,PSOSITE,"IB"))
WRITE !!,"Attempting to remove copay charges",!
DO RXED^PSOCPA
+2 IF COPAYFLG=0
WRITE !!,"Reason must be entered. Rx "_$PIECE(^PSRX(RXP,0),"^")_" not returned to stock.",!
+3 ;PFS: send Rx info to external billing system when copay and no copay.
+4 QUIT
ACT SET IFN=0
FOR I=0:0
SET I=$ORDER(^PSRX(RXP,"A",I))
if 'I
QUIT
SET IFN=I
+1 IF $GET(PSOWHERE)
SET COM=$GET(COM)_" (Released by CMOP)"
+2 IF +$GET(PSOPFS)
if $PIECE(PSOPFS,"^",3)'=""
SET COM=$GET(COM)_" (External Billing Charge ID: "_$PIECE(PSOPFS,"^",3)_")"
+3 DO NOW^%DTC
SET IFN=IFN+1
SET ^PSRX(RXP,"A",0)="^52.3DA^"_IFN_"^"_IFN
SET ^PSRX(RXP,"A",IFN,0)=%_"^I^"_DUZ_"^"_$SELECT(XTYPE="O":0,$GET(TYPE)'<0&($GET(TYPE)<6)&(XTYPE):TYPE,$GET(TYPE)>5&(XTYPE):(TYPE+1),1:6)_"^"_COM
+4 KILL DA
QUIT
CMOP ;original released by CMOP? Called by PSORESK
+1 SET PSXREL=$PIECE($GET(^PSRX(RXP,2)),"^",13)
+2 IF $GET(PSXREL)
IF ($DATA(^PSRX("AR",PSXREL,RXP,0)))
WRITE !!,$CHAR(7),"Rx # "_$PIECE(^PSRX(RXP,0),"^")_":",?20," Was dispensed by the CMOP and may not be returned"
+3 IF $TEST
WRITE !,?20," to stock at this facility."
QUIT
+4 KILL PSXREL
+5 QUIT
CMOP1 ; REFILL released by CMOP? Called by PSORESK
+1 IF +$GET(XTYPE)
SET PSXREL=$PIECE($GET(^PSRX(RXP,1,TYPE,0)),"^",18)
+2 IF $GET(PSXREL)
IF ($DATA(^PSRX("AR",PSXREL,RXP,TYPE)))
WRITE !!,"REFILL # "_TYPE_":",?20," Was dispensed by the CMOP and may not be returned"
+3 IF $TEST
WRITE !,?20," to stock at this facility."
QUIT
+4 KILL PSXREL
+5 QUIT
