PSODISPS ;BIR/SAB - CONTINUATION OF RELEASE FUNCTION ;3/2/93
;;7.0;OUTPATIENT PHARMACY;**15,13,9,27,67,71,156,118,148,247,200,385,703**;DEC 1997;Build 16
; Reference to ^PS(59.7 in ICR #694
; Reference to ^PSDRUG("AQ" in ICR #3165
; Reference to ^XTMP("PSA" in ICR #1036
; Reference to $$SERV^IBARX1 in ICR #2245
; Reference to ^PSDRUG( in ICR #221
; Reference to ^DIC(19.2 in ICR #1064
;
QTY ; Refill Release
S PSOCPN=$P(^PSRX(RXP,0),"^",2),QDRUG=$P(^PSRX(RXP,0),"^",6) K LBLP
F YY=0:0 S YY=$O(^PSRX(RXP,XTYPE,YY)) Q:'YY D:$P($G(^PSRX(RXP,XTYPE,YY,0)),"^")'<PSIN K ISUF,LBLP
.S RXFD=$E($P(^PSRX(RXP,XTYPE,YY,0),"^"),1,7),SUPN=$O(^PS(52.5,"B",RXP,0)) I SUPN,$D(^PS(52.5,"C",RXFD,SUPN)),$G(^PS(52.5,SUPN,"P"))'=1,$G(XTYPE) S ISUF=1 Q
.I XTYPE=1,($D(^PSDRUG("AQ",QDRUG))) K CMOP D RREL^PSOCMOPB(RXP,YY) K CMOP Q:$G(ISUF)
.I $P(^PSRX(RXP,XTYPE,YY,0),"^",$S($G(XTYPE):18,1:19))]""!($P(^(0),"^",16)) K IFN Q
.;
.F LBL=0:0 S LBL=$O(^PSRX(RXP,"L",LBL)) Q:'LBL I $P(^PSRX(RXP,"L",LBL,0),"^",2)=$S('XTYPE:(99-YY),1:YY) S LBLP=1
.Q:'$G(LBLP)
.D CHKADDR(RXP)
.;
.; - Checking for OPEN/UNRESOLVED 3rd. Party Payer Rejects / NDC Editing
.I XTYPE,$$MANREL^PSOBPSUT(RXP,YY,$G(PSOPID))="^" K LBLP Q
.;
.S IFN=YY S:$G(^PSDRUG(QDRUG,660.1))]"" QTY=$P(^PSRX(RXP,XTYPE,YY,0),"^",4),^PSDRUG(QDRUG,660.1)=^PSDRUG(QDRUG,660.1)-QTY
.K DA,DR,DIE D NOW^%DTC S DIE="^PSRX("_RXP_","""_XTYPE_""",",DA(1)=RXP
.S DA=YY,DR=$S(XTYPE:17,1:8)_"///"_%_";"_$S(XTYPE:4,1:.05)_"////"_PSRH
.S PSODT=% D ^DIE K DIE,DR,DA
.;
.; - Notifying IB through ECME of the Rx being released
.I XTYPE D IBSEND^PSOBPSUT(RXP,YY)
.;
.K PSODISPP S:$G(XTYPE)="P" PSODISPP=1 D EN^PSOHLSN1(RXP,"ZD") K PSODISPP
.K:XTYPE ^PSRX("ACP",$P($G(^PSRX(RXP,0)),"^",2),$P($G(^PSRX(RXP,1,YY,0)),"^"),YY,RXP)
.I XTYPE,$G(IFN),'$G(ISUF) S PSOCPRX=$P(^PSRX(RXP,0),"^") D CP^PSOCP
.;if appropriate update ^XTMP("PSA", for Drug Acct.
.I $G(PSODA),$G(PSODA(1)),'$D(^PSRX("AR",+PSODT,+RXP,YY)) D
..S ^XTMP("PSA",+PSOSITE,+QDRUG,DT)=$G(^XTMP("PSA",+PSOSITE,+QDRUG,DT))+$P($G(^PSRX(RXP,XTYPE,YY,0)),"^",4)
.;initialize bingo board variables
.I $G(IFN),$P($G(^PSRX(RXP,XTYPE,IFN,0)),"^",2)["W" S BINGRPR="W",BNGPDV=$P(^PSRX(RXP,XTYPE,IFN,0),"^",9),BINGNAM=$P($G(^PSRX(RXP,0)),"^",2)
;
I $G(IFN),XTYPE="P" S PSOPARTIAL=1
E S PSOPARTIAL=0
;
W:$G(IFN) !?7,"Prescription Number "_$P(^PSRX(RXP,0),"^")_$S('$G(XTYPE):" Partial Fill",1:" Refill(s)")_" Released" I $G(SPEED) G XMIT
W:'$G(IFN) !?7,"No "_$S($G(XTYPE):"Refill(s)",1:"Partial(s)")_" to be Released"
I $G(IFN),$$STATUS^PSOBPSUT(RXP)]"",$$WINFILL^PSODISPS(RXP),'$G(PSOPARTIAL) D SIGMSG^PSODISPS K IFN
XMIT I $G(PSODISP)=2.4 D ;build an send HL7 v2.4 messages to dispense system
. F I=0:0 S SUB=$O(^PSRX(RXP,"A",I)) Q:'I I $P(^PSRX(RXP,"A",I,0),"^",2)="N" D
.. D NOW^%DTC S PSODTM=% K ^UTILITY($J,"PSOHL")
.. S IDGN=$P(^PSRX(+RXP,0),"^",6),FP=$S(XTYPE=1:"R",1:"P")
.. S ^UTILITY($J,"PSOHL",1)=+RXP_"^"_IDGN_"^"_PSODTM_"^"_+$G(PDUZ)_"^0^^PSO DISP^^^"_FP_"^"_IFN
.. S ZTRTN="INIT^PSORELDT",ZTDESC="EXTERNAL INTERFACE FOR RELEASE DATE/TIME",ZTIO="",ZTDTH=$H,ZTSAVE("^UTILITY($J,""PSOHL"",")="",ZTSAVE("PSOSITE")="",ZTSAVE("RXP")="" D ^%ZTLOAD K ^UTILITY($J,"PSOHL")
K IFN
Q
;
STAT S RX0=^PSRX(RXP,0),$P(RX0,"^",15)=+^("STA"),RX2=^PSRX(RXP,2),J=RXP D ^PSOFUNC
W !!?5,$C(7),$C(7),"Rx# "_$P(^PSRX(RXP,0),"^")_" has a status of "_ST_" and is not eligible for",!?5,"release."_$S('$D(^XUSEC("PSORPH",DUZ)):" Please check with a Pharmacist!",1:"")
K RX0,ST
Q
;
OERR I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,?5,"Site Parameters must be defined to use the Release option!",! S VALMBCK="" Q
S VALMBCK="Q",Y=$G(^PS(59,PSOSITE,"IB")),PSOIBSS=$$SERV^IBARX1(+Y) I 'PSOIBSS D IBSSR^PSOUTL I 'PSOIBFL D S VALMBCK="" G EX
.W $C(7),!!,"The IB SERVICE/SECTION defined in your site parameter file is not valid.",!,"You will not be able to release any medication until this is corrected!",!
W !! S PSIN=+$P($G(^PS(59.7,1,49.99)),"^",2),RXP=$P(PSOLST($P(PSLST,",",ORD)),"^",2)
S DIC("S")="I $D(^XUSEC(""PSORPH"",+Y))",DIC("A")="Enter PHARMACIST: ",DIC="^VA(200,",DIC(0)="QEAM" D ^DIC G:"^"[X EX K DIC G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(Y=-1) EX S PSRH=+Y
;check for Drug Acct background job K8 & K7.1
S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19.2 D ^DIC I Y=-1 K DIC,X,Y G DOIT
I $P($G(Y(0)),U,2)>DT S PSODA=1 S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT G DOIT
S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19 D ^DIC K DIC,X G:Y=-1 DOIT
K DIQ,PSA S DA=+Y,DIC=19,DIQ="PSA",DR=200,DIQ(0)="IN" D EN^DIQ1
I '$D(PSA(19,DA,200,"I")) K DIC,DA,X,Y,DIQ G DOIT
I PSA(19,DA,200,"I")>DT S PSODA=1 S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT
K PSA,DIC,DA,X,Y,DIQ
;
DOIT S POERR=1 D FULL^VALM1,BC1^PSODISP
I $D(DISGROUP),$D(BINGNAM),($D(BINGDIV)!$D(BNGPDV)!$D(BNGRDV)),($D(BINGRO)!$D(BINGRPR)) N TM,TM1 D REL^PSOBING1 K BINGNAM,BINGDIV,BINGRO,BINGRPR,BNGPDV,BNGRDV
EX ;
K OUT,RX2,RXFD,RESK,ISUF,SUPN,%,DIC,IFN,J,DA,DR,DIE,X,X1,X2,Y,RXP,CX,PX,REC,DIR,YDT,REC,RDUZ,DIRUT,PSOCPN,PSOCPRX,PSOIBSS,PSOIBFL,PSOIBLP,PSOIBST,YY,QDRUG,QTY,TYPE,XTYPE,DUOUT,PSRH,XX,Y,PSIN,POERR,SUB
K DIR S DIR("A",1)=" ",DIR("A")="Press Return to Continue",DIR(0)="E" D ^DIR K DIRUT,DUOUT,DTOUT,DIR S VALMBCK="R"
S PSORXED=1 D ^PSOBUILD,ACT^PSOORNE2 K PSORXED
Q
;
CHKADDR(RXP) ;
N PSOTXT,PSOBADR,PSOTEMP,LBL
S LBL=$O(^PSRX(RXP,"L",99999),-1) I LBL>0 D
.S PSOTXT=$G(^PSRX(RXP,"L",LBL,0)) I PSOTXT'["(BAD ADDRESS)" Q
.S PSOBADR=$$CHKRX^PSOBAI(RXP)
.I '$G(PSOBADR) D SETLBL(LBL,"NO BAD ADDRESS INDICATOR AT RELEASE") Q
.I $P(PSOBADR,"^",2) D SETLBL(LBL,"ACTIVE TEMPORARY ADDRESS AT RELEASE")
Q
;
SETLBL(LBL,PSOMSG) ;
N PSOTXT
S PSOTXT=$G(^PSRX(RXP,"L",LBL,0)),$P(PSOTXT,"^",3)=PSOMSG
S LBL=LBL+1,^PSRX(RXP,"L",0)="^52.032DA^"_LBL_"^"_LBL
S ^PSRX(RXP,"L",LBL,0)=PSOTXT
Q
;
SIGMSG ;Display obtain signature alert in reverse video
I '$D(IORVON) D FULL^VALM1
W !!
W IORVON,"ePharmacy Rx - Obtain Signature",IORVOFF,!
Q
;
WINFILL(RX,RFL) ;Is this a Window prescription fill?
N WIN
S WIN=0
I '$G(RFL),$P(^PSRX(RX,0),"^",11)="W" S WIN=1 Q WIN
I $G(RFL)="" S RFL=$$LSTRFL^PSOBPSU1(RX)
I $P($G(^PSRX(RX,1,RFL,0)),"^",2)="W" S WIN=1
I $D(^PSRX("ADP",DT,RX,RFL)),$P($G(^PSRX(RX,"P",1,0)),U,2)="W" S WIN=1 ;Partials
Q WIN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODISPS 6347 printed Dec 13, 2024@02:27:10 Page 2
PSODISPS ;BIR/SAB - CONTINUATION OF RELEASE FUNCTION ;3/2/93
+1 ;;7.0;OUTPATIENT PHARMACY;**15,13,9,27,67,71,156,118,148,247,200,385,703**;DEC 1997;Build 16
+2 ; Reference to ^PS(59.7 in ICR #694
+3 ; Reference to ^PSDRUG("AQ" in ICR #3165
+4 ; Reference to ^XTMP("PSA" in ICR #1036
+5 ; Reference to $$SERV^IBARX1 in ICR #2245
+6 ; Reference to ^PSDRUG( in ICR #221
+7 ; Reference to ^DIC(19.2 in ICR #1064
+8 ;
QTY ; Refill Release
+1 SET PSOCPN=$PIECE(^PSRX(RXP,0),"^",2)
SET QDRUG=$PIECE(^PSRX(RXP,0),"^",6)
KILL LBLP
+2 FOR YY=0:0
SET YY=$ORDER(^PSRX(RXP,XTYPE,YY))
if 'YY
QUIT
if $PIECE($GET(^PSRX(RXP,XTYPE,YY,0)),"^")'<PSIN
Begin DoDot:1
+3 SET RXFD=$EXTRACT($PIECE(^PSRX(RXP,XTYPE,YY,0),"^"),1,7)
SET SUPN=$ORDER(^PS(52.5,"B",RXP,0))
IF SUPN
IF $DATA(^PS(52.5,"C",RXFD,SUPN))
IF $GET(^PS(52.5,SUPN,"P"))'=1
IF $GET(XTYPE)
SET ISUF=1
QUIT
+4 IF XTYPE=1
IF ($DATA(^PSDRUG("AQ",QDRUG)))
KILL CMOP
DO RREL^PSOCMOPB(RXP,YY)
KILL CMOP
if $GET(ISUF)
QUIT
+5 IF $PIECE(^PSRX(RXP,XTYPE,YY,0),"^",$SELECT($GET(XTYPE):18,1:19))]""!($PIECE(^(0),"^",16))
KILL IFN
QUIT
+6 ;
+7 FOR LBL=0:0
SET LBL=$ORDER(^PSRX(RXP,"L",LBL))
if 'LBL
QUIT
IF $PIECE(^PSRX(RXP,"L",LBL,0),"^",2)=$SELECT('XTYPE:(99-YY),1:YY)
SET LBLP=1
+8 if '$GET(LBLP)
QUIT
+9 DO CHKADDR(RXP)
+10 ;
+11 ; - Checking for OPEN/UNRESOLVED 3rd. Party Payer Rejects / NDC Editing
+12 IF XTYPE
IF $$MANREL^PSOBPSUT(RXP,YY,$GET(PSOPID))="^"
KILL LBLP
QUIT
+13 ;
+14 SET IFN=YY
if $GET(^PSDRUG(QDRUG,660.1))]""
SET QTY=$PIECE(^PSRX(RXP,XTYPE,YY,0),"^",4)
SET ^PSDRUG(QDRUG,660.1)=^PSDRUG(QDRUG,660.1)-QTY
+15 KILL DA,DR,DIE
DO NOW^%DTC
SET DIE="^PSRX("_RXP_","""_XTYPE_""","
SET DA(1)=RXP
+16 SET DA=YY
SET DR=$SELECT(XTYPE:17,1:8)_"///"_%_";"_$SELECT(XTYPE:4,1:.05)_"////"_PSRH
+17 SET PSODT=%
DO ^DIE
KILL DIE,DR,DA
+18 ;
+19 ; - Notifying IB through ECME of the Rx being released
+20 IF XTYPE
DO IBSEND^PSOBPSUT(RXP,YY)
+21 ;
+22 KILL PSODISPP
if $GET(XTYPE)="P"
SET PSODISPP=1
DO EN^PSOHLSN1(RXP,"ZD")
KILL PSODISPP
+23 if XTYPE
KILL ^PSRX("ACP",$PIECE($GET(^PSRX(RXP,0)),"^",2),$PIECE($GET(^PSRX(RXP,1,YY,0)),"^"),YY,RXP)
+24 IF XTYPE
IF $GET(IFN)
IF '$GET(ISUF)
SET PSOCPRX=$PIECE(^PSRX(RXP,0),"^")
DO CP^PSOCP
+25 ;if appropriate update ^XTMP("PSA", for Drug Acct.
+26 IF $GET(PSODA)
IF $GET(PSODA(1))
IF '$DATA(^PSRX("AR",+PSODT,+RXP,YY))
Begin DoDot:2
+27 SET ^XTMP("PSA",+PSOSITE,+QDRUG,DT)=$GET(^XTMP("PSA",+PSOSITE,+QDRUG,DT))+$PIECE($GET(^PSRX(RXP,XTYPE,YY,0)),"^",4)
End DoDot:2
+28 ;initialize bingo board variables
+29 IF $GET(IFN)
IF $PIECE($GET(^PSRX(RXP,XTYPE,IFN,0)),"^",2)["W"
SET BINGRPR="W"
SET BNGPDV=$PIECE(^PSRX(RXP,XTYPE,IFN,0),"^",9)
SET BINGNAM=$PIECE($GET(^PSRX(RXP,0)),"^",2)
End DoDot:1
KILL ISUF,LBLP
+30 ;
+31 IF $GET(IFN)
IF XTYPE="P"
SET PSOPARTIAL=1
+32 IF '$TEST
SET PSOPARTIAL=0
+33 ;
+34 if $GET(IFN)
WRITE !?7,"Prescription Number "_$PIECE(^PSRX(RXP,0),"^")_$SELECT('$GET(XTYPE):" Partial Fill",1:" Refill(s)")_" Released"
IF $GET(SPEED)
GOTO XMIT
+35 if '$GET(IFN)
WRITE !?7,"No "_$SELECT($GET(XTYPE):"Refill(s)",1:"Partial(s)")_" to be Released"
+36 IF $GET(IFN)
IF $$STATUS^PSOBPSUT(RXP)]""
IF $$WINFILL^PSODISPS(RXP)
IF '$GET(PSOPARTIAL)
DO SIGMSG^PSODISPS
KILL IFN
XMIT ;build an send HL7 v2.4 messages to dispense system
IF $GET(PSODISP)=2.4
Begin DoDot:1
+1 FOR I=0:0
SET SUB=$ORDER(^PSRX(RXP,"A",I))
if 'I
QUIT
IF $PIECE(^PSRX(RXP,"A",I,0),"^",2)="N"
Begin DoDot:2
+2 DO NOW^%DTC
SET PSODTM=%
KILL ^UTILITY($JOB,"PSOHL")
+3 SET IDGN=$PIECE(^PSRX(+RXP,0),"^",6)
SET FP=$SELECT(XTYPE=1:"R",1:"P")
+4 SET ^UTILITY($JOB,"PSOHL",1)=+RXP_"^"_IDGN_"^"_PSODTM_"^"_+$GET(PDUZ)_"^0^^PSO DISP^^^"_FP_"^"_IFN
+5 SET ZTRTN="INIT^PSORELDT"
SET ZTDESC="EXTERNAL INTERFACE FOR RELEASE DATE/TIME"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("^UTILITY($J,""PSOHL"",")=""
SET ZTSAVE("PSOSITE")=""
SET ZTSAVE("RXP")=""
DO ^%ZTLOAD
KILL ^UTILITY($JOB,"PSOHL")
End DoDot:2
End DoDot:1
+6 KILL IFN
+7 QUIT
+8 ;
STAT SET RX0=^PSRX(RXP,0)
SET $PIECE(RX0,"^",15)=+^("STA")
SET RX2=^PSRX(RXP,2)
SET J=RXP
DO ^PSOFUNC
+1 WRITE !!?5,$CHAR(7),$CHAR(7),"Rx# "_$PIECE(^PSRX(RXP,0),"^")_" has a status of "_ST_" and is not eligible for",!?5,"release."_$SELECT('$DATA(^XUSEC("PSORPH",DUZ)):" Please check with a Pharmacist!",1:"")
+2 KILL RX0,ST
+3 QUIT
+4 ;
OERR IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,?5,"Site Parameters must be defined to use the Release option!",!
SET VALMBCK=""
QUIT
+1 SET VALMBCK="Q"
SET Y=$GET(^PS(59,PSOSITE,"IB"))
SET PSOIBSS=$$SERV^IBARX1(+Y)
IF 'PSOIBSS
DO IBSSR^PSOUTL
IF 'PSOIBFL
Begin DoDot:1
+2 WRITE $CHAR(7),!!,"The IB SERVICE/SECTION defined in your site parameter file is not valid.",!,"You will not be able to release any medication until this is corrected!",!
End DoDot:1
SET VALMBCK=""
GOTO EX
+3 WRITE !!
SET PSIN=+$PIECE($GET(^PS(59.7,1,49.99)),"^",2)
SET RXP=$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
+4 SET DIC("S")="I $D(^XUSEC(""PSORPH"",+Y))"
SET DIC("A")="Enter PHARMACIST: "
SET DIC="^VA(200,"
SET DIC(0)="QEAM"
DO ^DIC
if "^"[X
GOTO EX
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!(Y=-1)
GOTO EX
SET PSRH=+Y
+5 ;check for Drug Acct background job K8 & K7.1
+6 SET X="PSA IV ALL LOCATIONS"
SET DIC(0)="MZ"
SET DIC=19.2
DO ^DIC
IF Y=-1
KILL DIC,X,Y
GOTO DOIT
+7 IF $PIECE($GET(Y(0)),U,2)>DT
SET PSODA=1
if '$PIECE($GET(^XTMP("PSA",0)),U,2)
SET $PIECE(^(0),U,2)=DT
GOTO DOIT
+8 SET X="PSA IV ALL LOCATIONS"
SET DIC(0)="MZ"
SET DIC=19
DO ^DIC
KILL DIC,X
if Y=-1
GOTO DOIT
+9 KILL DIQ,PSA
SET DA=+Y
SET DIC=19
SET DIQ="PSA"
SET DR=200
SET DIQ(0)="IN"
DO EN^DIQ1
+10 IF '$DATA(PSA(19,DA,200,"I"))
KILL DIC,DA,X,Y,DIQ
GOTO DOIT
+11 IF PSA(19,DA,200,"I")>DT
SET PSODA=1
if '$PIECE($GET(^XTMP("PSA",0)),U,2)
SET $PIECE(^(0),U,2)=DT
+12 KILL PSA,DIC,DA,X,Y,DIQ
+13 ;
DOIT SET POERR=1
DO FULL^VALM1
DO BC1^PSODISP
+1 IF $DATA(DISGROUP)
IF $DATA(BINGNAM)
IF ($DATA(BINGDIV)!$DATA(BNGPDV)!$DATA(BNGRDV))
IF ($DATA(BINGRO)!$DATA(BINGRPR))
NEW TM,TM1
DO REL^PSOBING1
KILL BINGNAM,BINGDIV,BINGRO,BINGRPR,BNGPDV,BNGRDV
EX ;
+1 KILL OUT,RX2,RXFD,RESK,ISUF,SUPN,%,DIC,IFN,J,DA,DR,DIE,X,X1,X2,Y,RXP,CX,PX,REC,DIR,YDT,REC,RDUZ,DIRUT,PSOCPN,PSOCPRX,PSOIBSS,PSOIBFL,PSOIBLP,PSOIBST,YY,QDRUG,QTY,TYPE,XTYPE,DUOUT,PSRH,XX,Y,PSIN,POERR,SUB
+2 KILL DIR
SET DIR("A",1)=" "
SET DIR("A")="Press Return to Continue"
SET DIR(0)="E"
DO ^DIR
KILL DIRUT,DUOUT,DTOUT,DIR
SET VALMBCK="R"
+3 SET PSORXED=1
DO ^PSOBUILD
DO ACT^PSOORNE2
KILL PSORXED
+4 QUIT
+5 ;
CHKADDR(RXP) ;
+1 NEW PSOTXT,PSOBADR,PSOTEMP,LBL
+2 SET LBL=$ORDER(^PSRX(RXP,"L",99999),-1)
IF LBL>0
Begin DoDot:1
+3 SET PSOTXT=$GET(^PSRX(RXP,"L",LBL,0))
IF PSOTXT'["(BAD ADDRESS)"
QUIT
+4 SET PSOBADR=$$CHKRX^PSOBAI(RXP)
+5 IF '$GET(PSOBADR)
DO SETLBL(LBL,"NO BAD ADDRESS INDICATOR AT RELEASE")
QUIT
+6 IF $PIECE(PSOBADR,"^",2)
DO SETLBL(LBL,"ACTIVE TEMPORARY ADDRESS AT RELEASE")
End DoDot:1
+7 QUIT
+8 ;
SETLBL(LBL,PSOMSG) ;
+1 NEW PSOTXT
+2 SET PSOTXT=$GET(^PSRX(RXP,"L",LBL,0))
SET $PIECE(PSOTXT,"^",3)=PSOMSG
+3 SET LBL=LBL+1
SET ^PSRX(RXP,"L",0)="^52.032DA^"_LBL_"^"_LBL
+4 SET ^PSRX(RXP,"L",LBL,0)=PSOTXT
+5 QUIT
+6 ;
SIGMSG ;Display obtain signature alert in reverse video
+1 IF '$DATA(IORVON)
DO FULL^VALM1
+2 WRITE !!
+3 WRITE IORVON,"ePharmacy Rx - Obtain Signature",IORVOFF,!
+4 QUIT
+5 ;
WINFILL(RX,RFL) ;Is this a Window prescription fill?
+1 NEW WIN
+2 SET WIN=0
+3 IF '$GET(RFL)
IF $PIECE(^PSRX(RX,0),"^",11)="W"
SET WIN=1
QUIT WIN
+4 IF $GET(RFL)=""
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+5 IF $PIECE($GET(^PSRX(RX,1,RFL,0)),"^",2)="W"
SET WIN=1
+6 ;Partials
IF $DATA(^PSRX("ADP",DT,RX,RFL))
IF $PIECE($GET(^PSRX(RX,"P",1,0)),U,2)="W"
SET WIN=1
+7 QUIT WIN
