2 S X=+PSGSA\1 F OD1=2:1:OD-1 I $P(PSGSA," ",OD1)'>$S(OD1>2:$P(PSGSA," ",OD1-1),1:PSGSA#1) S X1=X,X2=1 D C^%DTC
"RTN","PSIVCAL",101,0)
I PSIVSD,OD>2 S Y=X_PSIVSD
"RTN","PSIVCAL",102,0)
S PSIVADM=+Y,X=PSIVX,Y=PSIVY K PSGSA,PSIVSD,OD,OD1,PSIVMI,PSIVNOW S:PSIVADMP(2) S P(3)=X
"RTN","PSIVCAL",117,0)
I DDLX["L",($G(P(9))]""),("AH"'[$G(PSIVTYPE)) S LASTD=$$DOSES(DDLX,.P) I LASTD D
"RTN","PSIVCAL",118,0)
.S NEWDUR=$$FMDIFF^XLFDT(LASTD,P(2),2) I NEWDUR>0 S NEWDAYS=(NEWDUR/86400)
"RTN","PSIVCAL",119,0)
.I $G(NEWDAYS) I NEWDAYS1440) N PSIVSD,PSIVMIN,X S PSIVMIN=(+DDLX*PRAY(15)),PSIVSD=+PRAY(2) D ENT^PSIVWL S DOSAR(1)=Y Q
"RTN","PSIVCAL",146,0)
.I '$G(PRAY(11)) F I=2:1:DDLX+1 S DOSAR(I)=$$FMADD^XLFDT(DSTMP,,,PRAY(15)),DSTMP=DOSAR(I) Q
"RTN","PSIVCAL",147,0)
.I $G(PRAY(11)) N ADMS,NXT,LAST,DAY S LAST=$P(DSTMP,".",2),DAY=$P(DSTMP,".") D
"RTN","PSIVCAL",148,0)
..F II=1:1:$L(PRAY(11),"-") S ADMS(+$P(PRAY(11),"-",II))=$P(PRAY(11),"-",II)
"RTN","PSIVCAL",149,0)
..;*229 Include DOW Calc, Need to Q if DAY<0 if we go past max dt
"RTN","PSIVCAL",150,0)
..F IJ=2:1:DDLX+1 S NXT=$O(ADMS(+LAST)),LAST=NXT D Q:DAY<0
"RTN","PSIVCAL",151,0)
...I NXT="" S NXT=$O(ADMS(NXT)),LAST=NXT,DAY=$$FMADD^XLFDT(DAY,$$MWFD(PRAY(9),DAY)) Q:DAY<0
"RTN","PSIVCAL",152,0)
...S DOSAR(IJ)=DAY_"."_ADMS(NXT),DSTMP=DOSAR(IJ)
"RTN","PSIVCAL",153,0)
..I +DDLX=1 S NXT=$O(ADMS(LAST)),LAST=NXT D
"RTN","PSIVCAL",154,0)
...I NXT="" S NXT=$O(ADMS(NXT)),LAST=NXT
"RTN","PSIVCAL",155,0)
I $D(DOSAR) S LAST=$O(DOSAR(""),-1) I LAST S LAST=DOSAR(LAST)
"RTN","PSIVCAL",156,0)
Q LAST
"RTN","PSIVCAL",157,0)
;
"RTN","PSIVCAL",158,0)
MWFD(SCH,LAST) ;*229 Add to calc which days in DOW
"RTN","PSIVCAL",159,0)
;Calculate Days to add for DOW sched
"RTN","PSIVCAL",160,0)
N X,Y
"RTN","PSIVCAL",161,0)
I '$$DOW^PSIVUTL(SCH) Q 1 ;return 1 if not DOW
"RTN","PSIVCAL",162,0)
F I=1:1:7 S X=$$FMADD^XLFDT(LAST,I) D DW^%DTC I SCH[$E(X,1,2) S Y=I Q
"RTN","PSIVCAL",163,0)
Q Y
"RTN","PSIVCAL",164,0)
;
"RTN","PSIVSP")
0^2^B41011288^B38850432
"RTN","PSIVSP",1,0)
PSIVSP ;BIR/RGY,PR,CML3-DOSE PROCESSOR ; 1/3/12 3:36pm
"RTN","PSIVSP",2,0)
;;5.0;INPATIENT MEDICATIONS;**30,37,41,50,56,74,83,111,133,138,134,213,229**;16 DEC 97;Build 16
"RTN","PSIVSP",3,0)
;
"RTN","PSIVSP",4,0)
; Reference to ^PS(51.1 is supported by DBIA #2177
"RTN","PSIVSP",5,0)
;
"RTN","PSIVSP",6,0)
EN ;
"RTN","PSIVSP",7,0)
Q:'$D(X)
"RTN","PSIVSP",8,0)
S ATZERO=0 I X["@",$P(X,"@",2)=0 S ATZERO=1,X=$P(X,"@")
"RTN","PSIVSP",9,0)
D EN^PSGS0 S (P(9),PSIVSC1)=$S($G(X)]"":X,1:$G(P(9))),P(11)=$S($G(PSGS0Y):PSGS0Y,1:$G(P(11))),(XT,P(15))=$S(($G(PSGS0XT)!($G(PSGS0XT)="O")!($G(PSGS0XT)="D")):$G(PSGS0XT),1:$G(P(15)))
"RTN","PSIVSP",10,0)
I $G(ATZERO) S P(7)=1
"RTN","PSIVSP",11,0)
K ATZERO Q
"RTN","PSIVSP",12,0)
EN1 ;
"RTN","PSIVSP",13,0)
S (PSIVAT,PSIVWAT,Y)="",XT=-1,X0=X,X=$S(X="ON CALL":X,X="ONCALL":X,X="ON-CALL":X,X="ONETIME":X,X="ONE-TIME":X,X="ONE TIME":X,X="1TIME":X,X="1 TIME":X,X="1-TIME":X,$L(X," ")<3:$P(X," "),1:$P(X," ",1,2))
"RTN","PSIVSP",14,0)
S:$E(X)="^" X=$E(X,2,999) G:X="" Q S:X["@0" ATZERO=1 S X=$S(X["@0":$P(X,"@"),1:X),P(7)=$S($D(ATZERO):1,1:"") K ATZERO
"RTN","PSIVSP",15,0)
I $S($D(^PS(51.1,"AC","PSJ",X)):1,1:$E($O(^(X)),1,$L(X))=X) D DIC I Y'<0 G SH
"RTN","PSIVSP",16,0)
NS0 S Y=""
"RTN","PSIVSP",17,0)
I $E(X,1,2)="AD" S XT=-1 Q
"RTN","PSIVSP",18,0)
I $E(X,1,3)="BID"!($E(X,1,3)="TID")!($E(X,1,3)="QID") S XT=1440\$F("BTQ",$E(X))
"RTN","PSIVSP",19,0)
E S:$E(X)="Q" X=$E(X,2,99) S:'X X=$E(X)["O"+1_X S I=+X,X=$P(X,I,2),XT=I*$S(X["'":1,(X["D"&(X'["AD"))!(X["AM")!(X["PM")!(X["HS"&(X'["THS")):1440,X["H"&(X'["TH"):60,X["AC"!(X["PC"):480,X["W":10080,X["M":40320,1:0),X=X0 D
"RTN","PSIVSP",20,0)
. I 'XT,X'="NOW",X'="STAT",X'="ONCE",X'="ONE-TIME",X'="ONE TIME",X'="ONETIME",X'="1-TIME",X'="1 TIME",X'="1TIME",Y="" S XT=-1
"RTN","PSIVSP",21,0)
SH ;
"RTN","PSIVSP",22,0)
I +Y<1,$E(X0)'="^" W:$G(ON)'["P" " ",$S(XT=0&($S("^NOW^STAT^ONCE^ONE-TIME^ONETIME^1TIME^1-TIME^"[(U_$P(X," ")_U):1,X["1 TIME":1,1:X["ONE TIME")):"(ONCE ONLY)",XT>0:"Nonstandard schedule",XT<0:"",1:"(??)") W:XT>0 " (",XT," MINUTES)"
"RTN","PSIVSP",23,0)
Q Q:X="ONE TIME"
"RTN","PSIVSP",24,0)
N I S X0=$P(X," ")_$S($L(X0," ")-1:" ",1:"")_$P(X0," ",2,99) K:XT<0!($L(X0)>22) X S:$D(X) X=X0 K X0 S:$G(P(7)) XT="" Q
"RTN","PSIVSP",25,0)
NEWQ ;N I S X0=$P(X," ")_$S($L(X0," ")-1:" ",1:"")_$P(X0," ",2,99) K:XT<0!($L(X0)>22) X S:$D(X) X=X0 S:P(7) X=X0 K X0 K:XT>0&('P(7)) X Q
"RTN","PSIVSP",26,0)
Q
"RTN","PSIVSP",27,0)
;
"RTN","PSIVSP",28,0)
;*229 Add Temp val for dose limit in IOE
"RTN","PSIVSP",29,0)
ENDL N PSIVLIMT W " Dose limit .... " S PSIVLIMT="a"_X,PSIVMIN=P(15)*X,PSIVSD=+P(2)
"RTN","PSIVSP",30,0)
I PSIVMIN<0 W !!," --- There is something wrong with this order !!",!," Call inpatient supervisor ....." S Y=-1 K PSIVMIN Q
"RTN","PSIVSP",31,0)
I P(15)'["D",P(4)="P"!(P(5))!(P(23)="P"),PSIVMIN=0,"^NOW^STAT^ONCE^ONE-TIME^ONE TIME^ON CALL^ONETIME^1TIME^1 TIME^1-TIME^"'[(U_P(9)_U) D DLP G QDL
"RTN","PSIVSP",32,0)
;*229 DOW Calc and dose lim should match CPRS, if it's vol limit, we leave old functionality
"RTN","PSIVSP",33,0)
I $G(P(9))]"",$G(P(11))]"" D ENSTOP^PSIVCAL S Y=X I 1 ;*229 ENSTOP^PSIVCAL returns X, we wanted Y.
"RTN","PSIVSP",34,0)
E D ENT^PSIVWL
"RTN","PSIVSP",35,0)
QDL I $D(X) S X=Y X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) S Y=X
"RTN","PSIVSP",36,0)
Q
"RTN","PSIVSP",37,0)
DLP ;
"RTN","PSIVSP",38,0)
S X=X+1,$P(PSIVSD,".",2)=$P(PSIVSD,".",2)_$E("0000",1,4-$L($P(PSIVSD,".",2))) D CHK S X2=0,Y=1 I X<2 S Y=+PSIVSD G QDLP
"RTN","PSIVSP",39,0)
I $P(PSIVSD,".",2)>$P(P(11),"-",$L(P(11),"-")) S X2=1 G OV
"RTN","PSIVSP",40,0)
G:$P(P(11),"-")>$P(PSIVSD,".",2) OV
"RTN","PSIVSP",41,0)
F Y=1:1 S X1=$P(P(11),"-",Y) I X1=$P(PSIVSD,".",2)!($P(PSIVSD,".",2)0 S X1=PSIVSD D C^%DTC S X=$P(X,".") ; install with version 17.3 of fileman
"RTN","PSIVSP",45,0)
S Y=+(X_"."_$P(P(11),"-",Y))
"RTN","PSIVSP",46,0)
QDLP K X1,X2 Q
"RTN","PSIVSP",47,0)
;
"RTN","PSIVSP",48,0)
ENI ;
"RTN","PSIVSP",49,0)
K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X)!'$D(P(4)) Q
"RTN","PSIVSP",50,0)
;*229 Reset ATZERO flag.
"RTN","PSIVSP",51,0)
I $P(X,"@",2)'=0 S P(7)=""
"RTN","PSIVSP",52,0)
I P(4)="P"!(P(5))!(P(23)="P") Q:'X S X="INFUSE OVER "_X_" MINUTE"_$S(X>1:"S",1:"") W " ",X Q
"RTN","PSIVSP",53,0)
I $E(X)="." K X Q ;Enforce leading zero.
"RTN","PSIVSP",54,0)
I X'=+X!(X'=0_+X),X["@",($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)) K X Q
"RTN","PSIVSP",55,0)
S SPSOL=$O(DRG("SOL",0)) I 'SPSOL K SPSOL,X W " You must define at least one solution !!" Q
"RTN","PSIVSP",56,0)
I X=+X!(X=0_+X),X'["@" S X=X_" ml/hr" W " ml/hr" D SPSOL S P(15)=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q
"RTN","PSIVSP",57,0)
S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X!($P(X,"@")=0_+X) $P(X,"@")=$P(X,"@")_" ml/hr" W " ",+SPSOL," Label",$S(SPSOL'=1:"s",1:"")," per day",!?15,"at an infusion rate of: ",$P(X,"@") S P(15)=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL
"RTN","PSIVSP",58,0)
I X["@",$P(X,"@",2)=0 S P(7)=1 ; Set ATZERO flag
"RTN","PSIVSP",59,0)
Q
"RTN","PSIVSP",60,0)
SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(DRG("SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(DRG("SOL",XXX),U,3)
"RTN","PSIVSP",61,0)
K XXX Q
"RTN","PSIVSP",62,0)
CHK F Y=1:1 Q:$L(P(11))>240!($P(P(11),"-",Y)="") S $P(P(11),"-",Y)=$P(P(11),"-",Y)_$E("0000",1,4-$L($P(P(11),"-",Y)))
"RTN","PSIVSP",63,0)
Q
"RTN","PSIVSP",64,0)
;
"RTN","PSIVSP",65,0)
DIC ; 51.1 look-up
"RTN","PSIVSP",66,0)
N PSJSCH S PSJSCH=X I '$D(WSCHADM) N VAIP D IN5^VADPT S WSCHADM=VAIP(5),X=PSJSCH
"RTN","PSIVSP",67,0)
K DIC S DIC="^PS(51.1,",DIC(0)=$E("E",'$D(NOECH))_"ISZ"
"RTN","PSIVSP",68,0)
S DIC("W")="W "" "","_$S('$D(WSCHADM):"$P(^(0),""^"",2)",'+WSCHADM:"$P(^(0),""^"",2)",1:"$S($D(^PS(51.1,+Y,1,+WSCHADM,0)):$P(^(0),""^"",2),1:$P(^PS(51.1,+Y,0),""^"",2))"),D="APPSJ" S:$D(PSIVSPQF) DIC(0)=DIC(0)_"O"
"RTN","PSIVSP",69,0)
D IX^DIC K DIC
"RTN","PSIVSP",70,0)
S:$D(DIE)#2 DIC=DIE Q:Y<0
"RTN","PSIVSP",71,0)
S X=Y(0,0),ZZY=Y,(XT,Y)="" I $D(WSCHADM),$D(^PS(51.1,+ZZY,1,+WSCHADM,0)),$P(^(0),"^",2)]"" S (PSIVWAT,Y)=$P(^(0),"^",2)
"RTN","PSIVSP",72,0)
K ZZY,WSCHADM S:Y="" (X,PSIVSC1)=$P(Y(0),U),(PSIVAT,Y)=$P(Y(0),"^",2) S XT=$P(Y(0),"^",3) Q
"RTN","PSIVSP",73,0)
;
"RTN","PSIVSP",74,0)
ORINF ; OERR input transform for Infusion Rate
"RTN","PSIVSP",75,0)
; X=data
"RTN","PSIVSP",76,0)
N INFUSE
"RTN","PSIVSP",77,0)
K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
"RTN","PSIVSP",78,0)
I X?.E1L.E S INFUSE=$$ENLU^PSGMI(X) Q:(INFUSE="TITRATE")!(INFUSE="BOLUS")!($P(INFUSE," ")="INFUSE")!($P(INFUSE," ")="Infuse")
"RTN","PSIVSP",79,0)
Q:(X="TITRATE")!(X="BOLUS")!($P(X," ")="INFUSE")!($P(X," ")="Infuse")
"RTN","PSIVSP",80,0)
I X["=" D Q ; NOIS LOU-0501-42191
"RTN","PSIVSP",81,0)
.N X2,X1 S X1=$P(X,"="),X2=$P(X,"=",2)
"RTN","PSIVSP",82,0)
.I X1["ML/HR",(+X1=$P(X1,"ML/HR"))!(+X1=$P(X1," ML/HR")) D
"RTN","PSIVSP",83,0)
..S X1=$TR(X1,"ML/HR","ml/hr")
"RTN","PSIVSP",84,0)
.I X2["ML/HR",(+X2=$P(X2,"ML/HR"))!(+X2=$P(X2," ML/HR")) D
"RTN","PSIVSP",85,0)
..S X2=$TR(X2,"ML/HR","ml/hr")
"RTN","PSIVSP",86,0)
.I X1[" ml/hr",(+X1=$P(X1," ml/hr")) D
"RTN","PSIVSP",87,0)
..S X1=$P(X1," ml/hr")_$P(X1," ml/hr",2,9999)
"RTN","PSIVSP",88,0)
.I X2[" ml/hr",(+X2=$P(X2," ml/hr")) D
"RTN","PSIVSP",89,0)
..S X2=$P(X2," ml/hr")_$P(X2," ml/hr",2,9999)
"RTN","PSIVSP",90,0)
.I X1["ml/hr",(+X1=$P(X1,"ml/hr")) D
"RTN","PSIVSP",91,0)
..S X1=$P(X1,"ml/hr")_$P(X1,"ml/hr",2,9999)
"RTN","PSIVSP",92,0)
.I X2["ml/hr",(+X2=$P(X2,"ml/hr")) D
"RTN","PSIVSP",93,0)
..S X2=$P(X2,"ml/hr")_$P(X2,"ml/hr",2,9999)
"RTN","PSIVSP",94,0)
.I X2'=+X2 D
"RTN","PSIVSP",95,0)
..I X2>0&(X2<1) Q
"RTN","PSIVSP",96,0)
..I ($P(X2,"@",2,999)'=+$P(X2,"@",2,999)!(+$P(X2,"@",2,999)<0)) K X Q
"RTN","PSIVSP",97,0)
.I X1>0&(X1<1) I +X1="."_$P(X1,".",2) S X1=X1_" ml/hr"
"RTN","PSIVSP",98,0)
.I X2>0&(X2<1) I +X2="."_$P(X2,".",2) S X2=X2_" ml/hr"
"RTN","PSIVSP",99,0)
.I X1=+X1 S X1=X1_" ml/hr"
"RTN","PSIVSP",100,0)
.I X2=+X2 S X2=X2_" ml/hr"
"RTN","PSIVSP",101,0)
.S:$P(X2,"@")=+X2 $P(X2,"@")=$P(X2,"@")_" ml/hr"
"RTN","PSIVSP",102,0)
.S X=X1_"="_X2
"RTN","PSIVSP",103,0)
I X["ML/HR",(+X=$P(X,"ML/HR"))!(+X=$P(X," ML/HR")) S X=$TR(X,"ML/HR","ml/hr")
"RTN","PSIVSP",104,0)
I X[" ml/hr",+X=$P(X," ml/hr") S X=$P(X," ml/hr")_$P(X," ml/hr",2,9999)
"RTN","PSIVSP",105,0)
I X["ml/hr",+X=$P(X,"ml/hr") S X=$P(X,"ml/hr")_$P(X,"ml/hr",2,9999)
"RTN","PSIVSP",106,0)
I X>0,X<1 D Q
"RTN","PSIVSP",107,0)
.I X["ML/HR",(+X=$P($P(X,"ML/HR"),".",2))!(+X=$P($P(X," ML/HR"),".",2)) S X=$TR(X,"ML/HR","ml/hr")
"RTN","PSIVSP",108,0)
.I X[" ml/hr",(+X=$P($P(X," ml/hr"),".",2)) S X=$P(X," ml/hr")_$P(X," ml/hr",2,9999)
"RTN","PSIVSP",109,0)
.I X["ml/hr",+X=$P(X,"ml/hr") S X=$P(X,"ml/hr")_$P(X,"ml/hr",2,9999)
"RTN","PSIVSP",110,0)
.I +X=X S X=X_" ml/hr"
"RTN","PSIVSP",111,0)
.I $P(X,0,2)=+X S X=X_" ml/hr"
"RTN","PSIVSP",112,0)
.S X=0_+X_$P(X,+X,2)
"RTN","PSIVSP",113,0)
I '(X>0&X<1) I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)) K X Q
"RTN","PSIVSP",114,0)
I X=+X S X=X_" ml/hr" Q
"RTN","PSIVSP",115,0)
S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr"
"RTN","PSIVSP",116,0)
Q
"VER")
8.0^22.0
"BLD",8256,6)
^252
**END**
**END**