- 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
- 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
