- PSOORNE5 ;BIR/SAB - display orders from backdoor con't ;06-Dec-2012 20:20;PLS
- ;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,78,99,117,131,146,171,180,1013,210,222,268,206,225,1015**;DEC 1997;Build 62
- ;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
- ; Modified - IHS/MSC/PLS - 09/20/2011 - Line PEN+6
- ; - 10/05/2011 - Line PEN+14
- ; 12/06/2012 - Line RDSPL+10
- 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
- ;IHS/MSC/PLS - 09/20/2011
- D FULL^VALM1
- I '$$PMTFORD^APSPFUNC(ORD) S ORD=ORSV,VALMBCK="R" Q
- ;I '$G(PSOTPBFG) D DSPL^PSOTPCAN(ORD)
- ;S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" Q
- 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 ; D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)_"S") I '$G(PSOMSG) S VAMLSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),PSOACT="" K PSOMSG G OK ;VALMBCK="" Q
- 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."
- ;IHS/MSC/MGH Add text for REM medication Patch 1013
- D REMMSG^APSPFUNC(PSODRG)
- K PSOMSG S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEFX",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")
- 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 ;S X=PSODFN_";DPT(" D ULK^ORX2
- 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 S PSODIR("CS")=0
- F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSODIR("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSODIR("CS"),"^",2)=1
- I $P($G(PSODIR("CS")),"^",2)=1 S (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=0 Q
- I '$D(CLOZPAT) I PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2) S (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=0 Q
- I $D(CLOZPAT) S (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=$S($G(CLOZPAT)=2&(PSONEW("DAYS SUPPLY")=14):1,$G(CLOZPAT)=2&(PSONEW("DAYS SUPPLY")=7):3,$G(CLOZPAT)=1&(PSONEW("DAYS SUPPLY")=7):1,1:0) Q
- I PSODIR("CS") D
- .S PSOX=5,PSOX1=$S($P($G(PSONEW("PTST NODE")),"^",4)>PSOX:PSOX,1:$P($G(PSONEW("PTST NODE")),"^",4)),PSOX=$S(PSOX1=5:PSOX,1:PSOX1)
- .S PSOX=$S('PSOX:0,PSONEW("DAYS SUPPLY")=90:1,1:PSOX),PSDY=PSONEW("DAYS SUPPLY"),PSDY1=$S(PSDY<60:5,PSDY'<60&(PSDY'>89):2,PSDY=90:1,1:0) S PSOX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- .I PSONEW("# OF REFILLS")>PSOX S (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=PSOX
- E D
- .;IHS/MSC/PLS - 12/06/2012
- .;S PSOX=11,PSOX1=$S($P($G(PSONEW("PTST NODE")),"^",4)>PSOX:PSOX,1:$P($G(PSONEW("PTST NODE")),"^",4)),PSOX=$S(PSOX1=11:PSOX,1:PSOX1)
- .S PSOX=15,PSOX1=$S($P($G(PSONEW("PTST NODE")),"^",4)>PSOX:PSOX,1:$P($G(PSONEW("PTST NODE")),"^",4)),PSOX=$S(PSOX1=11:PSOX,1:PSOX1)
- .;S PSDY=PSONEW("DAYS SUPPLY"),PSDY1=$S(PSDY<60:11,PSDY'<60&(PSDY'>89):5,PSDY=90:3,1:0) S PSOX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- .S PSDY=PSONEW("DAYS SUPPLY"),PSDY1=$S(PSDY<60:15,PSDY<90:5,PSDY=90:3,PSDY<168:2,PSDY<365:1,1:0) S PSOX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- .I PSONEW("# OF REFILLS")>PSOX S (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=PSOX
- 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!"
- ;I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" S ACTREF=0
- 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
- ;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
- PSOORNE5 ;BIR/SAB - display orders from backdoor con't ;06-Dec-2012 20:20;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,78,99,117,131,146,171,180,1013,210,222,268,206,225,1015**;DEC 1997;Build 62
- +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 ; Modified - IHS/MSC/PLS - 09/20/2011 - Line PEN+6
- +10 ; - 10/05/2011 - Line PEN+14
- +11 ; 12/06/2012 - Line RDSPL+10
- 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 ;IHS/MSC/PLS - 09/20/2011
- +7 DO FULL^VALM1
- +8 IF '$$PMTFORD^APSPFUNC(ORD)
- SET ORD=ORSV
- SET VALMBCK="R"
- QUIT
- +9 ;I '$G(PSOTPBFG) D DSPL^PSOTPCAN(ORD)
- +10 ;S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" Q
- +11 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
- +12 ; D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)_"S") I '$G(PSOMSG) S VAMLSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),PSOACT="" K PSOMSG G OK ;VALMBCK="" Q
- KILL PSOPLCK
- +13 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."
- +14 ;IHS/MSC/MGH Add text for REM medication Patch 1013
- +15 DO REMMSG^APSPFUNC(PSODRG)
- +16 KILL PSOMSG
- SET PSOACT=$SELECT($DATA(^XUSEC("PSORPH",DUZ)):"DEFX",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
- 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 ;S X=PSODFN_";DPT(" D ULK^ORX2
- 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 SET PSODIR("CS")=0
- +1 FOR DEA=1:1
- IF $EXTRACT(PSODRUG("DEA"),DEA)=""
- QUIT
- IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
- IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
- SET $PIECE(PSODIR("CS"),"^")=1
- IF $EXTRACT(+PSODRUG("DEA"),DEA)=2
- SET $PIECE(PSODIR("CS"),"^",2)=1
- +2 IF $PIECE($GET(PSODIR("CS")),"^",2)=1
- SET (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=0
- QUIT
- +3 IF '$DATA(CLOZPAT)
- IF PSODRUG("DEA")["A"&(PSODRUG("DEA")'["B")!(PSODRUG("DEA")["F")!(PSODRUG("DEA")[1)!(PSODRUG("DEA")[2)
- SET (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=0
- QUIT
- +4 IF $DATA(CLOZPAT)
- SET (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=$SELECT($GET(CLOZPAT)=2&(PSONEW("DAYS SUPPLY")=14):1,$GET(CLOZPAT)=2&(PSONEW("DAYS SUPPLY")=7):3,$GET(CLOZPAT)=1&(PSONEW("DAYS SUPPLY")=7):1,1:0)
- QUIT
- +5 IF PSODIR("CS")
- Begin DoDot:1
- +6 SET PSOX=5
- SET PSOX1=$SELECT($PIECE($GET(PSONEW("PTST NODE")),"^",4)>PSOX:PSOX,1:$PIECE($GET(PSONEW("PTST NODE")),"^",4))
- SET PSOX=$SELECT(PSOX1=5:PSOX,1:PSOX1)
- +7 SET PSOX=$SELECT('PSOX:0,PSONEW("DAYS SUPPLY")=90:1,1:PSOX)
- SET PSDY=PSONEW("DAYS SUPPLY")
- SET PSDY1=$SELECT(PSDY<60:5,PSDY'<60&(PSDY'>89):2,PSDY=90:1,1:0)
- SET PSOX=$SELECT(PSOX'>PSDY1:PSOX,1:PSDY1)
- +8 IF PSONEW("# OF REFILLS")>PSOX
- SET (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=PSOX
- End DoDot:1
- +9 IF '$TEST
- Begin DoDot:1
- +10 ;IHS/MSC/PLS - 12/06/2012
- +11 ;S PSOX=11,PSOX1=$S($P($G(PSONEW("PTST NODE")),"^",4)>PSOX:PSOX,1:$P($G(PSONEW("PTST NODE")),"^",4)),PSOX=$S(PSOX1=11:PSOX,1:PSOX1)
- +12 SET PSOX=15
- SET PSOX1=$SELECT($PIECE($GET(PSONEW("PTST NODE")),"^",4)>PSOX:PSOX,1:$PIECE($GET(PSONEW("PTST NODE")),"^",4))
- SET PSOX=$SELECT(PSOX1=11:PSOX,1:PSOX1)
- +13 ;S PSDY=PSONEW("DAYS SUPPLY"),PSDY1=$S(PSDY<60:11,PSDY'<60&(PSDY'>89):5,PSDY=90:3,1:0) S PSOX=$S(PSOX'>PSDY1:PSOX,1:PSDY1)
- +14 SET PSDY=PSONEW("DAYS SUPPLY")
- SET PSDY1=$SELECT(PSDY<60:15,PSDY<90:5,PSDY=90:3,PSDY<168:2,PSDY<365:1,1:0)
- SET PSOX=$SELECT(PSOX'>PSDY1:PSOX,1:PSDY1)
- +15 IF PSONEW("# OF REFILLS")>PSOX
- SET (PSONEW("# OF REFILLS"),PSONEW("N# REF"))=PSOX
- End DoDot:1
- +16 QUIT
- 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 ;I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" S ACTREF=0
- +7 SET PSORFRM=$PIECE(RX0,"^",9)
- FOR PSOJ=0:0
- SET PSOJ=$ORDER(^PSRX(RXN,1,PSOJ))
- IF 'PSOJ
- QUIT
- SET PSORFRM=PSORFRM-1
- +8 IF PSORFRM<0
- SET PSORFRM=0
- IF PSORFRM=0
- SET ACTREF=0
- +9 IF $GET(RXFL(RXN))]""
- IF '$PIECE(PSOPAR,"^",6)
- SET ACTREF=0
- +10 IF $PIECE(PSODRUG0,"^",3)["A"&($PIECE(PSODRUG0,"^",3)'["B")!($PIECE(PSODRUG0,"^",3)["F")!($PIECE(PSODRUG0,"^",3)[1)!($PIECE(PSODRUG0,"^",3)[2)
- SET ACTREF=0
- +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
- SV SET VALMSG="Pre-POE Rx. Please Compare Dosing Fields with SIG!"
- +1 QUIT
