PSORESK1.m

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 ---PSORESK1   1898     printed  Apr 09, 2024@21:35:11                                                                                                                                                                                                    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