- 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 Apr 23, 2025@18:48:19 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
