PSXREL ;BIR/WPB-Manual Barcode Release/Not Dispense ;04/08/97 2:06 PM
;;2.0;CMOP;**38**;11 Apr 97
AC ;
I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
W !!,"This option will only release/complete Rx's which have labels printed manually." W !!
AC1 ;
S DIR(0)="S^R:RELEASE;C:NOT DISPENSED",DIR("?",1)="Enter 'R' to release a prescription that has been filled.",DIR("?")="Enter 'C' to mark a prescription as not filled." D ^DIR K DIR S ACT=$G(Y)
K DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y,X
G:$G(ACT)="R" RPH
CAN I $G(ACT)="C" W !! S DIR("A")="Enter Cancel Reason",DIR(0)="F^1:40" D ^DIR K DIR S REASON=$G(Y) I $G(REASON)="" G CAN
G:$G(Y)=""!($D(DIRUT))!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) EXIT
K DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
RPH S DIC("S")="I $D(^XUSEC(""PSXRPH"",+Y))",DIC("A")="Enter PHARMACIST: ",DIC="^VA(200,",DIC(0)="QEAM" D ^DIC K DIC G:"^"[X EXIT G:$D(DTOUT)!($D(DUOUT))!(Y=-1) EXIT S PSRH=+Y K Y,X,DTOUT,DUOUT
BC W !! K DIR,Y,X,RXN S DIR("A")="Enter/Wand PRESCRIPTION number",DIR("?")="^D HELP^PSXREL",DIR(0)="FO",DIR("??")="^D LIST^PSXREL" D ^DIR K DIR S RXN=X
G:$D(DIRUT) EXIT
K DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
;I RXN'["-" W !,"INVALID PRESCRIPTION NUMBER" G BC
I '$D(^PSX(552.3,"AP",RXN)) W !,"INVALID PRESCRIPTION NUMBER" G BC
S PSX=$O(^PSX(552.3,"AP",RXN,"")) I '$G(PSX) W !,"INVALID PRESCRIPTION NUMBER" K X,PSX,RXN G BC
I '$D(^PSX(552.3,PSX,0)) W !,"INVALID PRESCRIPTION NUMBER" K X,RXN,PSX G BC
S PSXN=PSX,PSX=^PSX(552.3,PSX,0),Y=$P(PSX,"|",7) I +$G(Y)>0 W !,"PREVIOUSLY RELEASED ON " X ^DD("DD") W Y K Y,^PSX(552.3,"AP",RXN,PSXN),PSX,PSXN G BC
D NOW^%DTC S $P(^PSX(552.3,PSXN,0),"|",7)=%_"|"_PSRH_"|"_$G(REASON)
S ^PSX(552.3,PSXN,1)=2,^PSX(552.3,"AQ",PSXN)="" K ^PSX(552.3,"AP",$G(RXN),PSXN),%
W !!,"RX# ",$P(PSX,"|",4)_$S($G(ACT)="R":" released.",$G(ACT)="C":" not dispensed.",1:"") G BC
Q
EXIT K X,Y,%,PSX,PSXN,DA,DIC,DIRUT,DUOUT,PSRH,DIR,DTOUT,DIROUT,ACT,REASON,RXN
Q
HELP W !!,"Wand the barcode number of the prescription or manually key in"
W !,"the number printed below the barcode."
W !,"The barcode number should be of the format - 'NNN-NNNNNNN'"
Q
LIST S ZZ="" F S ZZ=$O(^PSX(552.3,"AP",ZZ)) Q:ZZ="" W !,?5,$G(ZZ)
K ZZ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXREL 2239 printed Apr 09, 2024@20:50:33 Page 2
PSXREL ;BIR/WPB-Manual Barcode Release/Not Dispense ;04/08/97 2:06 PM
+1 ;;2.0;CMOP;**38**;11 Apr 97
AC ;
+1 IF '$DATA(^XUSEC("PSXCMOPMGR",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+2 WRITE !!,"This option will only release/complete Rx's which have labels printed manually."
WRITE !!
AC1 ;
+1 SET DIR(0)="S^R:RELEASE;C:NOT DISPENSED"
SET DIR("?",1)="Enter 'R' to release a prescription that has been filled."
SET DIR("?")="Enter 'C' to mark a prescription as not filled."
DO ^DIR
KILL DIR
SET ACT=$GET(Y)
+2 KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y,X
+3 if $GET(ACT)="R"
GOTO RPH
CAN IF $GET(ACT)="C"
WRITE !!
SET DIR("A")="Enter Cancel Reason"
SET DIR(0)="F^1:40"
DO ^DIR
KILL DIR
SET REASON=$GET(Y)
IF $GET(REASON)=""
GOTO CAN
+1 if $GET(Y)=""!($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIROUT))
GOTO EXIT
+2 KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
RPH SET DIC("S")="I $D(^XUSEC(""PSXRPH"",+Y))"
SET DIC("A")="Enter PHARMACIST: "
SET DIC="^VA(200,"
SET DIC(0)="QEAM"
DO ^DIC
KILL DIC
if "^"[X
GOTO EXIT
if $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
GOTO EXIT
SET PSRH=+Y
KILL Y,X,DTOUT,DUOUT
BC WRITE !!
KILL DIR,Y,X,RXN
SET DIR("A")="Enter/Wand PRESCRIPTION number"
SET DIR("?")="^D HELP^PSXREL"
SET DIR(0)="FO"
SET DIR("??")="^D LIST^PSXREL"
DO ^DIR
KILL DIR
SET RXN=X
+1 if $DATA(DIRUT)
GOTO EXIT
+2 KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT,X,Y
+3 ;I RXN'["-" W !,"INVALID PRESCRIPTION NUMBER" G BC
+4 IF '$DATA(^PSX(552.3,"AP",RXN))
WRITE !,"INVALID PRESCRIPTION NUMBER"
GOTO BC
+5 SET PSX=$ORDER(^PSX(552.3,"AP",RXN,""))
IF '$GET(PSX)
WRITE !,"INVALID PRESCRIPTION NUMBER"
KILL X,PSX,RXN
GOTO BC
+6 IF '$DATA(^PSX(552.3,PSX,0))
WRITE !,"INVALID PRESCRIPTION NUMBER"
KILL X,RXN,PSX
GOTO BC
+7 SET PSXN=PSX
SET PSX=^PSX(552.3,PSX,0)
SET Y=$PIECE(PSX,"|",7)
IF +$GET(Y)>0
WRITE !,"PREVIOUSLY RELEASED ON "
XECUTE ^DD("DD")
WRITE Y
KILL Y,^PSX(552.3,"AP",RXN,PSXN),PSX,PSXN
GOTO BC
+8 DO NOW^%DTC
SET $PIECE(^PSX(552.3,PSXN,0),"|",7)=%_"|"_PSRH_"|"_$GET(REASON)
+9 SET ^PSX(552.3,PSXN,1)=2
SET ^PSX(552.3,"AQ",PSXN)=""
KILL ^PSX(552.3,"AP",$GET(RXN),PSXN),%
+10 WRITE !!,"RX# ",$PIECE(PSX,"|",4)_$SELECT($GET(ACT)="R":" released.",$GET(ACT)="C":" not dispensed.",1:"")
GOTO BC
+11 QUIT
EXIT KILL X,Y,%,PSX,PSXN,DA,DIC,DIRUT,DUOUT,PSRH,DIR,DTOUT,DIROUT,ACT,REASON,RXN
+1 QUIT
HELP WRITE !!,"Wand the barcode number of the prescription or manually key in"
+1 WRITE !,"the number printed below the barcode."
+2 WRITE !,"The barcode number should be of the format - 'NNN-NNNNNNN'"
+3 QUIT
LIST SET ZZ=""
FOR
SET ZZ=$ORDER(^PSX(552.3,"AP",ZZ))
if ZZ=""
QUIT
WRITE !,?5,$GET(ZZ)
+1 KILL ZZ
+2 QUIT
