PSOORNE5 ;BIR/SAB - display orders from backdoor con't ;Oct 21, 2022@11:20
;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,78,99,117,131,146,171,180,210,222,268,206,225,391,444,504,441,545**;DEC 1997;Build 270
;External reference to ^PSDRUG supported by DBIA 221
;External references L and UL^PSSLOCK supported by DBIA 2789
;External reference to ^PS(51.2 supported by DBIA 2226
;External reference to ^PS(50.607 supported by DBIA 2221
;External reference ^PS(55 supported by DBIA 2228
;called from PSOORNE2
;PSO*210 add call to WORDWRAP api
;
PEN ;pending orders
K ^TMP("PSOPO",$J),PSORX("ISSUE DATE"),PSORX("FILL DATE") S ORSV=ORD,ORD=$P(PSOLST(ORN),"^",2)
I $P($G(^PS(52.41,ORD,0)),"^",3)="DC"!($P($G(^(0)),"^",3)="DE") S VALMBCK="R" Q
I $G(PSODFN)'=$P($G(^PS(52.41,ORD,0)),"^",2) S VALMBCK="" Q
I $G(PSOTPBFG) N PSOTPPEN,PSOTPPEX S PSOTPPEN=ORD,PSOTPPEX=0 D VOPNR^PSOTPCAN I PSOTPPEX K PSOTPPEX,PSOTPPEN S VALMBCK="R" Q
K PSOTPPEX,PSOTPPEN
I '$G(PSOFIN) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient."),VALMBCK="" K PSOPLCK Q
K PSOPLCK
S PSODRG=+$P($G(^PS(52.41,ORD,0)),"^",9) I $G(^PSDRUG(PSODRG,"I"))]"",DT>$G(^("I")) S VALMSG="This Drug has been Inactivated."
I $P($G(^PS(52.41,ORD,0)),"^",24) S PSOACT=$S($D(^XUSEC("PSDRPH",DUZ)):"DEFX",$D(^XUSEC("PSORPH",DUZ)):"F",$P($G(PSOPAR),"^",2):"F",1:"")
E S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEFX",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")
K PSOMSG
OK S PAT=PSODFN,PSORNSV=ORN,PSORNLT=PSLST D ORD^PSOORFIN S PSLST=PSORNLT,ORD=ORSV,ORN=PSORNSV K ORSV,PSORNSV,PSORNLT,PSODRUG S VALMBCK="R"
K ORCHK,ORDRG,PSOFDR,SIGOK,PSONEW,PSORX("ISSUE DATE"),PSORX("FILL DATE"),PSORX("FN")
K:'$G(MEDP) PAT
D CLEAN^PSOVER1
I '$G(PSOFIN) D UL^PSSLOCK(PSODFN)
Q
RXNCHK S PSOY=$O(PSONEW("OLD LAST RX#","")) I PSOY="" D AUTO^PSONRXN Q
S PSONRXN("TYPE")=$S('+$G(^PS(59,+PSOSITE,2)):8,PSODRUG("DEA")["A"&(+$G(^PS(59,+PSOSITE,2))):3,1:8)
S PSONEW("QFLG")=0 I PSOY'=PSONRXN("TYPE"),$P($G(PSOPAR),"^",7)=1 D
.S DIE="^PS(59,",DA=PSOSITE,PSOX=PSONEW("OLD LAST RX#",PSOY)
.L +^PS(59,+PSOSITE,PSOY):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
.S DR=$S(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX)
.D:PSOX<$P(^PS(59,+PSOSITE,PSOY),"^",3) ^DIE K DIE,X,Y L -^PS(59,+PSOSITE,PSOY)
.L +^PS(59,+PSOSITE,PSONRXN("TYPE")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
.S PSOX1=^PS(59,+PSOSITE,PSONRXN("TYPE")),PSONRXN("LO")=$P(PSOX1,"^")
.S PSONRXN("HI")=$P(PSOX1,"^",2),PSOI=$P(PSOX1,"^",3),PSONEW("OLD LAST RX#",PSONRXN("TYPE"))=PSOI
.S:PSOI<PSONRXN("LO") PSOI=PSONRXN("LO")
.D LOOP2 I PSONEW("QFLG") L -^PS(59,+PSOSITE,PSONRXN("TYPE")),-^PSRX("B",PSOI) Q
.K DIC,DIE,DA S DIE=59,DA=PSOSITE
.S DR=$S(PSONRXN("TYPE")=8:"2003////"_PSOI,PSONRXN("TYPE")=3:"1002.1////"_PSOI,1:"2003////"_PSOI)
.S PSONEW("RX #")=PSOI D ^DIE K DIE,DIC,DR,DA L -^PS(59,+PSOSITE,PSONRXN("TYPE"))
.K PSOX1,PSONRXN,PSOI,X,Y
Q
LOOP2 F S PSOI=PSOI+1 D:PSOI>PSONRXN("HI") FATAL^PSONRXN Q:'$D(^PSRX("B",PSOI))!PSONEW("QFLG")
L +^PSRX("B",PSOI):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I $D(^PSRX("B",PSOI))!'$T G LOOP2
L -^PSRX("B",PSOI)
Q
RDSPL ;
; Retrieving the Maximum Number of Refills allowed
N MAXRF S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSONEW("DAYS SUPPLY")),+$G(PSONEW("PATIENT STATUS")),.CLOZPAT)
S (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=$S(($G(PSONEW("# OF REFILLS"))'="")&($G(PSONEW("# OF REFILLS"))'>MAXRF):PSONEW("# OF REFILLS"),1:MAXRF)
Q
;
GET ;
I $P(PSODRUG0,"^",3)["2" S (ACTREF,ACTREN)=0 Q
S (ACTREF,ACTREN)=1
;refills
I ST S ACTREF=0
I '$P(PSOPAR,"^",11),$G(^PSDRUG(PSODRG,"I"))]"",DT>$G(^("I")) S ACTREF=0,VALMSG="Inactive Drug, Non Refillable!"
S PSORFRM=$P(RX0,"^",9) F PSOJ=0:0 S PSOJ=$O(^PSRX(RXN,1,PSOJ)) Q:'PSOJ S PSORFRM=PSORFRM-1
S:PSORFRM<0 PSORFRM=0 S:PSORFRM=0 ACTREF=0
I $G(RXFL(RXN))]"",'$P(PSOPAR,"^",6) S ACTREF=0
I $P(PSODRUG0,"^",3)["A"&($P(PSODRUG0,"^",3)'["B")!($P(PSODRUG0,"^",3)["F")!($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2) S ACTREF=0
I PSORFRM=0,'$O(^PSRX(RXN,"L",0)),$G(^PSRX(RXN,"PARK")) S ACTREF=1 ;*441 - IF ORIGINAL FILL PARKED, NO REFILLS AND NO LABEL PREVIOUSLY PRINTED - PROCESS ORIGINAL FILL WHEN REFILL IS REQUESTED
;renews
I $P(PSOPAR,"^",4)=0 S ACTREN=0 Q
I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" S ACTREN=0
I $G(^PSDRUG(PSODRG,"I"))]"",DT>$G(^("I")) S ACTREN=0,VALMSG="This Drug has been Inactivated."
I '$P($G(^PSDRUG(PSODRG,2)),"^"),'$P($G(^PSRX(RXN,"OR1")),"^") S ACTREN=0,VALMSG="Drug must be Matched to an Orderable Item!"
I ($P(PSODRUG0,"^",3)["W")!($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2) S ACTREN=0
I $D(^PS(53,+$P(RX0,"^",3),0)),'$P(^(0),"^",5) S ACTREN=0
S PSOLC=$P(RX0,"^"),PSOLC=$E(PSOLC,$L(PSOLC)) I $A(PSOLC)'<90 S ACTREN=0
I ST,ST'=2,ST'=5,ST'=6,ST'=11,ST'=12 S ACTREN=0
K PSORFRM,PSOLC,PSODRG,PSODRUG0
Q
INST ;formats instruction from front door
D INST^PSOORNE6 Q
PC ;displays provider comments
D PC^PSOORNE6 Q
INST1 ;formats instruction from front door
D INST1^PSOORNE6 Q
PC1 ;displays provider comments
D PC1^PSOORNE6 Q
DOSE ;displays dosing instruction for both simple and complex backdoor Rxs.
I '$O(^PSRX(RXN,6,0)) S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" (3) Dosage: " Q
S DS=1 F I=0:0 S I=$O(^PSRX(RXN,6,I)) Q:'I S DOSE=^PSRX(RXN,6,I,0) D
.I '$P(DOSE,"^",2),$P(DOSE,"^",9)]"" S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Verb: "_$P(DOSE,"^",9)
.I $G(DS)=1 S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" (3)"
.D DOSE1 S PSORXED("ENT")=$G(PSORXED("ENT"))+1
K DOSE,I
Q
DOSE1 ;
I $G(DS)=1 S ^TMP("PSOAO",$J,IEN,0)=^TMP("PSOAO",$J,IEN,0)_" *Dosage: "_$S($E($P(DOSE,"^"),1)="."&($P(DOSE,"^",2)):"0",1:"")_$P(DOSE,"^")_$S($P(DOSE,"^",3)]"":" ("_$P(^PS(50.607,$P(DOSE,"^",3),0),"^")_")",1:"") K DS G DU
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" *Dosage: "_$S($E($P(DOSE,"^"),1)="."&($P(DOSE,"^",2)):"0",1:"")_$P(DOSE,"^")_$S($P(DOSE,"^",3)]"":" ("_$P(^PS(50.607,$P(DOSE,"^",3),0),"^")_")",1:"")
DU I '$P(DOSE,"^",2),$P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(^PSRX(RXN,6,I,1))
I $P(DOSE,"^",2),$P(DOSE,"^",9)]"" D
.S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Verb: "_$P(DOSE,"^",9)
.S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Dispense Units: "_$S($E($P(DOSE,"^",2),1)=".":"0",1:"")_$P(DOSE,"^",2)
.S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Noun: "_$P(DOSE,"^",4)
I $P(DOSE,"^",7) S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" *Route: "_$P(^PS(51.2,$P(DOSE,"^",7),0),"^")
S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" *Schedule: "_$P(DOSE,"^",8)
I $P(DOSE,"^",5)]"" D
.S DUR=$S($E($P(DOSE,"^",5),1)'?.N:$E($P(DOSE,"^",5),2,99)_$E($P(DOSE,"^",5),1),1:$P(DOSE,"^",5))
.S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" *Duration: "_DUR_" ("_$S($P(DOSE,"^",5)["M":"MINUTES",$P(DOSE,"^",5)["H":"HOURS",$P(DOSE,"^",5)["L":"MONTHS",$P(DOSE,"^",5)["W":"WEEKS",1:"DAYS")_")" K DUR
I $P(DOSE,"^",6)]"" S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" *Conjunction: "_$S($P(DOSE,"^",6)="A":"AND",$P(DOSE,"^",6)="T":"THEN",$P(DOSE,"^",6)="X":"EXCEPT",1:"")
Q
INS ;patient instructions ;PSO*210
I $G(^PSRX(RXN,"INS"))]"",'$O(^PSRX(RXN,"INS1",0)) D K SG G SPINS
.S PSORXED("SIG",1)=^PSRX(RXN,"INS")
.D WORDWRAP^PSOUTLA2(^PSRX(RXN,"INS"),.IEN,$NA(^TMP("PSOAO",$J)),21)
;
I $O(^PSRX(RXN,"INS1",0)) D
.S T=0 F S T=$O(^PSRX(RXN,"INS1",T)) Q:'T D
.. S (PSORXED("SIG",T),MIG)=^PSRX(RXN,"INS1",T,0)
.. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAO",$J)),21)
SPINS K T,SG,MIG
I $P($G(^PS(55,PSODFN,"LAN")),"^") S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Other Pat. Instruc: "_$S($G(^PSRX(RXN,"INSS"))]"":^PSRX(RXN,"INSS"),1:"")
Q
;
SV S VALMSG="Pre-POE Rx. Please Compare Dosing Fields with SIG!"
Q
PRV ;
N DETN,DEA,I,LBL,VADD,SPC,ORN S ORN=ORD
S DEA=$$RXDEA^PSOUTIL(+$G(RXN))
;*545 - show only DEA label
S LBL=" DEA#: "
I $$DETOX^PSSOPKI($P(RX0,"^",6)) S DETN=$$RXDETOX^PSOUTIL(+$G(RXN))
S $P(SPC," ",(28-$L(DEA)))=" "
I (DEA'="")!($G(DETN)'="") S IEN=IEN+1,$E(^TMP("PSOAO",$J,IEN,0),16)=LBL_DEA_$S($G(DETN)]"":SPC_"DETOX#: "_$G(DETN),1:"")
D PRVAD^PSOPKIV2
I $G(VADD(1))]"" D
.S IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" Site Address: "_VADD(1)
.S:VADD(2)'="" IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" "_VADD(2) S:VADD(3)'="" IEN=IEN+1,^TMP("PSOAO",$J,IEN,0)=" "_VADD(3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNE5 8639 printed Nov 22, 2024@17:42:09 Page 2
PSOORNE5 ;BIR/SAB - display orders from backdoor con't ;Oct 21, 2022@11:20
+1 ;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,78,99,117,131,146,171,180,210,222,268,206,225,391,444,504,441,545**;DEC 1997;Build 270
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External references L and UL^PSSLOCK supported by DBIA 2789
+4 ;External reference to ^PS(51.2 supported by DBIA 2226
+5 ;External reference to ^PS(50.607 supported by DBIA 2221
+6 ;External reference ^PS(55 supported by DBIA 2228
+7 ;called from PSOORNE2
+8 ;PSO*210 add call to WORDWRAP api
+9 ;
PEN ;pending orders
+1 KILL ^TMP("PSOPO",$JOB),PSORX("ISSUE DATE"),PSORX("FILL DATE")
SET ORSV=ORD
SET ORD=$PIECE(PSOLST(ORN),"^",2)
+2 IF $PIECE($GET(^PS(52.41,ORD,0)),"^",3)="DC"!($PIECE($GET(^(0)),"^",3)="DE")
SET VALMBCK="R"
QUIT
+3 IF $GET(PSODFN)'=$PIECE($GET(^PS(52.41,ORD,0)),"^",2)
SET VALMBCK=""
QUIT
+4 IF $GET(PSOTPBFG)
NEW PSOTPPEN,PSOTPPEX
SET PSOTPPEN=ORD
SET PSOTPPEX=0
DO VOPNR^PSOTPCAN
IF PSOTPPEX
KILL PSOTPPEX,PSOTPPEN
SET VALMBCK="R"
QUIT
+5 KILL PSOTPPEX,PSOTPPEN
+6 IF '$GET(PSOFIN)
SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)
IF '$GET(PSOPLCK)
SET VALMSG=$SELECT($PIECE($GET(PSOPLCK),"^",2)'="":$PIECE($GET(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.")
SET VALMBCK=""
KILL PSOPLCK
QUIT
+7 KILL PSOPLCK
+8 SET PSODRG=+$PIECE($GET(^PS(52.41,ORD,0)),"^",9)
IF $GET(^PSDRUG(PSODRG,"I"))]""
IF DT>$GET(^("I"))
SET VALMSG="This Drug has been Inactivated."
+9 IF $PIECE($GET(^PS(52.41,ORD,0)),"^",24)
SET PSOACT=$SELECT($DATA(^XUSEC("PSDRPH",DUZ)):"DEFX",$DATA(^XUSEC("PSORPH",DUZ)):"F",$PIECE($GET(PSOPAR),"^",2):"F",1:"")
+10 IF '$TEST
SET PSOACT=$SELECT($DATA(^XUSEC("PSORPH",DUZ)):"DEFX",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
+11 KILL PSOMSG
OK SET PAT=PSODFN
SET PSORNSV=ORN
SET PSORNLT=PSLST
DO ORD^PSOORFIN
SET PSLST=PSORNLT
SET ORD=ORSV
SET ORN=PSORNSV
KILL ORSV,PSORNSV,PSORNLT,PSODRUG
SET VALMBCK="R"
+1 KILL ORCHK,ORDRG,PSOFDR,SIGOK,PSONEW,PSORX("ISSUE DATE"),PSORX("FILL DATE"),PSORX("FN")
+2 if '$GET(MEDP)
KILL PAT
+3 DO CLEAN^PSOVER1
+4 IF '$GET(PSOFIN)
DO UL^PSSLOCK(PSODFN)
+5 QUIT
RXNCHK SET PSOY=$ORDER(PSONEW("OLD LAST RX#",""))
IF PSOY=""
DO AUTO^PSONRXN
QUIT
+1 SET PSONRXN("TYPE")=$SELECT('+$GET(^PS(59,+PSOSITE,2)):8,PSODRUG("DEA")["A"&(+$GET(^PS(59,+PSOSITE,2))):3,1:8)
+2 SET PSONEW("QFLG")=0
IF PSOY'=PSONRXN("TYPE")
IF $PIECE($GET(PSOPAR),"^",7)=1
Begin DoDot:1
+3 SET DIE="^PS(59,"
SET DA=PSOSITE
SET PSOX=PSONEW("OLD LAST RX#",PSOY)
+4 LOCK +^PS(59,+PSOSITE,PSOY):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
+5 SET DR=$SELECT(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX)
+6 if PSOX<$PIECE(^PS(59,+PSOSITE,PSOY),"^",3)
DO ^DIE
KILL DIE,X,Y
LOCK -^PS(59,+PSOSITE,PSOY)
+7 LOCK +^PS(59,+PSOSITE,PSONRXN("TYPE")):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
+8 SET PSOX1=^PS(59,+PSOSITE,PSONRXN("TYPE"))
SET PSONRXN("LO")=$PIECE(PSOX1,"^")
+9 SET PSONRXN("HI")=$PIECE(PSOX1,"^",2)
SET PSOI=$PIECE(PSOX1,"^",3)
SET PSONEW("OLD LAST RX#",PSONRXN("TYPE"))=PSOI
+10 if PSOI<PSONRXN("LO")
SET PSOI=PSONRXN("LO")
+11 DO LOOP2
IF PSONEW("QFLG")
LOCK -^PS(59,+PSOSITE,PSONRXN("TYPE")),-^PSRX("B",PSOI)
QUIT
+12 KILL DIC,DIE,DA
SET DIE=59
SET DA=PSOSITE
+13 SET DR=$SELECT(PSONRXN("TYPE")=8:"2003////"_PSOI,PSONRXN("TYPE")=3:"1002.1////"_PSOI,1:"2003////"_PSOI)
+14 SET PSONEW("RX #")=PSOI
DO ^DIE
KILL DIE,DIC,DR,DA
LOCK -^PS(59,+PSOSITE,PSONRXN("TYPE"))
+15 KILL PSOX1,PSONRXN,PSOI,X,Y
End DoDot:1
+16 QUIT
LOOP2 FOR
SET PSOI=PSOI+1
if PSOI>PSONRXN("HI")
DO FATAL^PSONRXN
if '$DATA(^PSRX("B",PSOI))!PSONEW("QFLG")
QUIT
+1 LOCK +^PSRX("B",PSOI):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF $DATA(^PSRX("B",PSOI))!'$TEST
GOTO LOOP2
+2 LOCK -^PSRX("B",PSOI)
+3 QUIT
RDSPL ;
+1 ; Retrieving the Maximum Number of Refills allowed
+2 NEW MAXRF
SET MAXRF=$$MAXNUMRF^PSOUTIL(+$GET(PSODRUG("IEN")),+$GET(PSONEW("DAYS SUPPLY")),+$GET(PSONEW("PATIENT STATUS")),.CLOZPAT)
+3 SET (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=$SELECT(($GET(PSONEW("# OF REFILLS"))'="")&($GET(PSONEW("# OF REFILLS"))'>MAXRF):PSONEW("# OF REFILLS"),1:MAXRF)
+4 QUIT
+5 ;
GET ;
+1 IF $PIECE(PSODRUG0,"^",3)["2"
SET (ACTREF,ACTREN)=0
QUIT
+2 SET (ACTREF,ACTREN)=1
+3 ;refills
+4 IF ST
SET ACTREF=0
+5 IF '$PIECE(PSOPAR,"^",11)
IF $GET(^PSDRUG(PSODRG,"I"))]""
IF DT>$GET(^("I"))
SET ACTREF=0
SET VALMSG="Inactive Drug, Non Refillable!"
+6 SET PSORFRM=$PIECE(RX0,"^",9)
FOR PSOJ=0:0
SET PSOJ=$ORDER(^PSRX(RXN,1,PSOJ))
if 'PSOJ
QUIT
SET PSORFRM=PSORFRM-1
+7 if PSORFRM<0
SET PSORFRM=0
if PSORFRM=0
SET ACTREF=0
+8 IF $GET(RXFL(RXN))]""
IF '$PIECE(PSOPAR,"^",6)
SET ACTREF=0
+9 IF $PIECE(PSODRUG0,"^",3)["A"&($PIECE(PSODRUG0,"^",3)'["B")!($PIECE(PSODRUG0,"^",3)["F")!($PIECE(PSODRUG0,"^",3)[1)!($PIECE(PSODRUG0,"^",3)[2)
SET ACTREF=0
+10 ;*441 - IF ORIGINAL FILL PARKED, NO REFILLS AND NO LABEL PREVIOUSLY PRINTED - PROCESS ORIGINAL FILL WHEN REFILL IS REQUESTED
IF PSORFRM=0
IF '$ORDER(^PSRX(RXN,"L",0))
IF $GET(^PSRX(RXN,"PARK"))
SET ACTREF=1
+11 ;renews
+12 IF $PIECE(PSOPAR,"^",4)=0
SET ACTREN=0
QUIT
+13 IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^",3)'["O"
SET ACTREN=0
+14 IF $GET(^PSDRUG(PSODRG,"I"))]""
IF DT>$GET(^("I"))
SET ACTREN=0
SET VALMSG="This Drug has been Inactivated."
+15 IF '$PIECE($GET(^PSDRUG(PSODRG,2)),"^")
IF '$PIECE($GET(^PSRX(RXN,"OR1")),"^")
SET ACTREN=0
SET VALMSG="Drug must be Matched to an Orderable Item!"
+16 IF ($PIECE(PSODRUG0,"^",3)["W")!($PIECE(PSODRUG0,"^",3)[1)!($PIECE(PSODRUG0,"^",3)[2)
SET ACTREN=0
+17 IF $DATA(^PS(53,+$PIECE(RX0,"^",3),0))
IF '$PIECE(^(0),"^",5)
SET ACTREN=0
+18 SET PSOLC=$PIECE(RX0,"^")
SET PSOLC=$EXTRACT(PSOLC,$LENGTH(PSOLC))
IF $ASCII(PSOLC)'<90
SET ACTREN=0
+19 IF ST
IF ST'=2
IF ST'=5
IF ST'=6
IF ST'=11
IF ST'=12
SET ACTREN=0
+20 KILL PSORFRM,PSOLC,PSODRG,PSODRUG0
+21 QUIT
INST ;formats instruction from front door
+1 DO INST^PSOORNE6
QUIT
PC ;displays provider comments
+1 DO PC^PSOORNE6
QUIT
INST1 ;formats instruction from front door
+1 DO INST1^PSOORNE6
QUIT
PC1 ;displays provider comments
+1 DO PC1^PSOORNE6
QUIT
DOSE ;displays dosing instruction for both simple and complex backdoor Rxs.
+1 IF '$ORDER(^PSRX(RXN,6,0))
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" (3) Dosage: "
QUIT
+2 SET DS=1
FOR I=0:0
SET I=$ORDER(^PSRX(RXN,6,I))
if 'I
QUIT
SET DOSE=^PSRX(RXN,6,I,0)
Begin DoDot:1
+3 IF '$PIECE(DOSE,"^",2)
IF $PIECE(DOSE,"^",9)]""
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Verb: "_$PIECE(DOSE,"^",9)
+4 IF $GET(DS)=1
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" (3)"
+5 DO DOSE1
SET PSORXED("ENT")=$GET(PSORXED("ENT"))+1
End DoDot:1
+6 KILL DOSE,I
+7 QUIT
DOSE1 ;
+1 IF $GET(DS)=1
SET ^TMP("PSOAO",$JOB,IEN,0)=^TMP("PSOAO",$JOB,IEN,0)_" *Dosage: "_$SELECT($EXTRACT($PIECE(DOSE,"^"),1)="."&($PIECE(DOSE,"^",2)):"0",1:"")_$PIECE(DOSE,"^")_$SELECT($PIECE(DOSE,"^",3)]"":" ("_$PIECE(^PS(50.607,$PIECE(DOSE,"^",3),0),"
^")_")",1:"")
KILL DS
GOTO DU
+2 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" *Dosage: "_$SELECT($EXTRACT($PIECE(DOSE,"^"),1)="."&($PIECE(DOSE,"^",2)):"0",1:"")_$PIECE(DOSE,"^")_$SELECT($PIECE(DOSE,"^",3)]"":" ("_$PIECE(^PS(50.607,$PIECE(DOSE,"^",3),0),"^")_")",1:"")
DU IF '$PIECE(DOSE,"^",2)
IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Oth. Lang. Dosage: "_$GET(^PSRX(RXN,6,I,1))
+1 IF $PIECE(DOSE,"^",2)
IF $PIECE(DOSE,"^",9)]""
Begin DoDot:1
+2 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Verb: "_$PIECE(DOSE,"^",9)
+3 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Dispense Units: "_$SELECT($EXTRACT($PIECE(DOSE,"^",2),1)=".":"0",1:"")_$PIECE(DOSE,"^",2)
+4 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Noun: "_$PIECE(DOSE,"^",4)
End DoDot:1
+5 IF $PIECE(DOSE,"^",7)
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" *Route: "_$PIECE(^PS(51.2,$PIECE(DOSE,"^",7),0),"^")
+6 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" *Schedule: "_$PIECE(DOSE,"^",8)
+7 IF $PIECE(DOSE,"^",5)]""
Begin DoDot:1
+8 SET DUR=$SELECT($EXTRACT($PIECE(DOSE,"^",5),1)'?.N:$EXTRACT($PIECE(DOSE,"^",5),2,99)_$EXTRACT($PIECE(DOSE,"^",5),1),1:$PIECE(DOSE,"^",5))
+9 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" *Duration: "_DUR_" ("_$SELECT($PIECE(DOSE,"^",5)["M":"MINUTES",$PIECE(DOSE,"^",5)["H":"HOURS",$PIECE(DOSE,"^",5)["L":"MONTHS",$PIECE(DOSE,"^",5)["W":"WEEKS",1:"DAYS")_")"
KILL DUR
End DoDot:1
+10 IF $PIECE(DOSE,"^",6)]""
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" *Conjunction: "_$SELECT($PIECE(DOSE,"^",6)="A":"AND",$PIECE(DOSE,"^",6)="T":"THEN",$PIECE(DOSE,"^",6)="X":"EXCEPT",1:"")
+11 QUIT
INS ;patient instructions ;PSO*210
+1 IF $GET(^PSRX(RXN,"INS"))]""
IF '$ORDER(^PSRX(RXN,"INS1",0))
Begin DoDot:1
+2 SET PSORXED("SIG",1)=^PSRX(RXN,"INS")
+3 DO WORDWRAP^PSOUTLA2(^PSRX(RXN,"INS"),.IEN,$NAME(^TMP("PSOAO",$JOB)),21)
End DoDot:1
KILL SG
GOTO SPINS
+4 ;
+5 IF $ORDER(^PSRX(RXN,"INS1",0))
Begin DoDot:1
+6 SET T=0
FOR
SET T=$ORDER(^PSRX(RXN,"INS1",T))
if 'T
QUIT
Begin DoDot:2
+7 SET (PSORXED("SIG",T),MIG)=^PSRX(RXN,"INS1",T,0)
+8 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOAO",$JOB)),21)
End DoDot:2
End DoDot:1
SPINS KILL T,SG,MIG
+1 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Other Pat. Instruc: "_$SELECT($GET(^PSRX(RXN,"INSS"))]"":^PSRX(RXN,"INSS"),1:"")
+2 QUIT
+3 ;
SV SET VALMSG="Pre-POE Rx. Please Compare Dosing Fields with SIG!"
+1 QUIT
PRV ;
+1 NEW DETN,DEA,I,LBL,VADD,SPC,ORN
SET ORN=ORD
+2 SET DEA=$$RXDEA^PSOUTIL(+$GET(RXN))
+3 ;*545 - show only DEA label
+4 SET LBL=" DEA#: "
+5 IF $$DETOX^PSSOPKI($PIECE(RX0,"^",6))
SET DETN=$$RXDETOX^PSOUTIL(+$GET(RXN))
+6 SET $PIECE(SPC," ",(28-$LENGTH(DEA)))=" "
+7 IF (DEA'="")!($GET(DETN)'="")
SET IEN=IEN+1
SET $EXTRACT(^TMP("PSOAO",$JOB,IEN,0),16)=LBL_DEA_$SELECT($GET(DETN)]"":SPC_"DETOX#: "_$GET(DETN),1:"")
+8 DO PRVAD^PSOPKIV2
+9 IF $GET(VADD(1))]""
Begin DoDot:1
+10 SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" Site Address: "_VADD(1)
+11 if VADD(2)'=""
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" "_VADD(2)
if VADD(3)'=""
SET IEN=IEN+1
SET ^TMP("PSOAO",$JOB,IEN,0)=" "_VADD(3)
End DoDot:1
+12 QUIT
