PSIVEC:PSIVEC,1:P(3)) S:OD=CD CD=CD+.0001 D ENP3^PSIVWL
"RTN","PSIVORE1",29,0)
P ;*305
"RTN","PSIVORE1",30,0)
S:'$D(PSGSA) PSGSA=""
"RTN","PSIVORE1",31,0)
D FULL^VALM1
"RTN","PSIVORE1",32,0)
W:PSGCNT !!,PSGCNT," Label",$E("s",PSGCNT>1)," needed for dose",$E("s",PSGCNT>1)," due at ...",!!
"RTN","PSIVORE1",33,0)
F Y=1:1 S X=$P(PSGSA," ",Y) S:$E(X)="." X=$$CONVER^PSIVORE2(X,Y) Q:X="" W:PSGCNT $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" "_$E(X#1_"000",2,5)_" : "
"RTN","PSIVORE1",34,0)
W ! D:$P(PSIVSITE,U,8) TL^PSIVORE2 D NOW^%DTC S Y=% S PNOW=Y I $D(^PS(59.5,PSIVSN,3,"AT")) W !!,"Next delivery time is " S X=$O(^PS(59.5,PSIVSN,3,"AT",PNOW#1)) S:X="" X=$O(^(X)) S X=$P(X,".",2)_$E("000",1,5-$L(X)) W X," ***" G B1
"RTN","PSIVORE1",35,0)
ACT ; Prompt and process label action.
"RTN","PSIVORE1",36,0)
B I PSGCNT<1 S:($G(RNDT)&$G(OP2)) P(2)=OP2 G K^PSIVORE2
"RTN","PSIVORE1",37,0)
B1 ;
"RTN","PSIVORE1",38,0)
W ! S X="Action (PB"_$S($P(PSIVSITE,U,2):"S",1:"")_")^"_$S(PSGCNT<1:"B",$G(PSJPRI)="D":"B",$P(PSIVSITE,U,2)&$D(X):"S",1:"P")_"^^PRINT LABELS,BYPASS"_$S($P(PSIVSITE,U,2):",SUSPEND LABELS",1:"")
"RTN","PSIVORE1",39,0)
D ENQ^PSIV S X=$E(X) S:X["?" HELP="ANSWER" D:X["?" ^PSIVHLP G:X["?" B1 I "B^"[X G K^PSIVORE2
"RTN","PSIVORE1",40,0)
I "S"[X,$D(^PS(55,"PSIVSUS",PSIVSN,DFN,ON)) D C^PSIVORE2 W !!,"There ",$S(SNM>1:"are",1:"is")," already ",SNM," LABEL",$E("S",SNM>1)," suspended for this order." K SNM,DAT
"RTN","PSIVORE1",41,0)
SS ;
"RTN","PSIVORE1",42,0)
S PSIVA=X,X="# of labels^"_PSGCNT_"^^^QUX=+QUX&(QUX?1N.N)" D ENQ^PSIV W !!
"RTN","PSIVORE1",43,0)
S PSIVLABN=X I X["?"!(X>99) S X=PSIVA W !,"Enter # labels, less than 100, to act on." G SS
"RTN","PSIVORE1",44,0)
I 'X W " No action taken ***" G B1
"RTN","PSIVORE1",45,0)
I PSIVA="S",$D(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PNOW)) W $C(7),"NO Labels suspended, Wait 8 seconds and try again." D NOW^%DTC S Y=% S PNOW=Y G B1
"RTN","PSIVORE1",46,0)
S $P(^(0),U,16)=$P(^PS(55,DFN,"IV",+ON,0),U,16)+X,PSIVNOL=+X,PSGCNT=PSGCNT-X,PSIVDOSE=$P(PSGSA," ",1,X),PLAST=$P(PSGSA," "),PLAST="."_$P(PLAST,".",2),PSGSA=$P(PSGSA," ",X+1,999) I PLAST>$P(PSGSA," ") S UP1=1
"RTN","PSIVORE1",47,0)
S P(16)=$P(^PS(55,DFN,"IV",+ON,0),U,16)
"RTN","PSIVORE1",48,0)
I $D(UP1) S:$D(X1)#2 XX1=X1 S:$D(X2)#2 XX2=X2 S X1=$E(PSIVDOSE,1,7),X2=1 D C^%DTC S PSGSA=X_PSGSA S:$D(XX1) X1=XX1 S:$D(XX2) X2=XX2 K XX2,XX1
"RTN","PSIVORE1",49,0)
I '$D(UP1) S PSGSA=$E(PSIVDOSE,1,7)_PSGSA
"RTN","PSIVORE1",50,0)
K UP1 I PSIVA="S" S ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PNOW)=PSIVLABN_U_PSIVDOSE_U_P(16),Y=0,P(16)=P(16)+X W " ... ",PSIVLABN," Label",$E("s",PSIVLABN>1)," suspended !" S ACTION=5,PSIVNOL=PSIVLABN,TRACK=4 D ^PSIVLTR,NOW^%DTC S Y=% S PNOW=Y K X G B
"RTN","PSIVORE1",51,0)
S IONOFF="" I PSIVPL=ION S P16=P(16),ACTION=1,TRACK=4 D ^PSIVLTR D ^PSIVHYPL:P(4)="H",^PSIVLABL:"APSC"[P(4) S P(16)=$P(^PS(55,DFN,"IV",+ON,0),U,16) G B
"RTN","PSIVORE1",52,0)
W ! S P16=P(16),P(16)=P(16)+X,ZTDTH=$H,ZTIO=PSIVPL F Y="IONOFF","P16","PSIVDOSE","PSIVSITE","PSIVSN","PSIVNOL","DFN","ON","PSJSYSL","PSJSYSW0","PSJSYSW","PSJSYSP","PSJSYSP0","PSJSYSU" S ZTSAVE(Y)=""
"RTN","PSIVORE1",53,0)
S ZTDESC="PRINT IV LABELS",ZTRTN="DEQ^PSIVORE2" D ^%ZTLOAD G B
"RTN","PSIVORE1",54,0)
GSTRING ; Setup edit "^" string.
"RTN","PSIVORE1",55,0)
S PSIVOK="57^58^59^10^3^25^26^39^1^64^63"_$S($E(P("OT"))="I":"^101",1:"")
"RTN","PSIVORE1",56,0)
S EDIT="57^58^59^10^3^25^26^39^1^"_$S(P("OT")="I":"101^",1:"")_"64^63"
"RTN","PSIVORE1",57,0)
;* S EDIT="57^58^59^10^3^25^26^39^1^"_$S(P("DTYP")=1:"101^",1:"")_"64^63"
"RTN","PSIVORE1",58,0)
Q
"RTN","PSIVSP")
0^3^B42459538^B42203793
"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,279,305**;16 DEC 97;Build 3
"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")&($$SCHREQ^PSJLIVFD(.P)) ATZERO=1 S X=$S(X["@0":$P(X,"@"),1:X),P(7)=$S($G(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) (ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:ADMSD)_"."_ADMTM_" "
"RTN","PSIVWL",59,0)
.. ;F ADM=1:1:$L(P(11),"-") S ADMTM=$P(P(11),"-",ADM) I OD'>(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:PSIVSD)_"."_ADMTM_" "
"RTN","PSIVWL",60,0)
Q:+$G(PSIVX)
"RTN","PSIVWL",61,0)
I '$D(^PS(51.1,"APPSJ",P(9))) S PSIVX=1,P9=$P(P(9),"@") F X=1:1:$L(P9,"-") D Q:'$G(PSIVX)
"RTN","PSIVWL",62,0)
. I '(",MO,TU,WE,TH,FR,SA,SU,"[(","_$P(P9,"-",X)_",")) S PSIVX=0 Q
"RTN","PSIVWL",63,0)
. I ODCDWD[$E($P(P9,"-",X),1,2) D
"RTN","PSIVWL",64,0)
.. S ADMSD=$S($P(ODCDWD,"^")[$P(P9,"-",X):OD,1:CD)\1
"RTN","PSIVWL",65,0)
.. F ADM=1:1:$L(P(11),"-") S ADMTM=$P(P(11),"-",ADM) I OD'>(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:ADMSD)_"."_ADMTM_" "
"RTN","PSIVWL",66,0)
.. ;F ADM=1:1:$L(P(11),"-") S ADMTM=$P(P(11),"-",ADM) I OD'>(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:PSIVSD)_"."_ADMTM_" "
"RTN","PSIVWL",67,0)
Q:+$G(PSIVX)
"RTN","PSIVWL",68,0)
F Y=1:1 S (PSIVMI,MI)=$P(P(11),"-",Y),PSIVSD=+(PSIVSD\1_"."_MI) Q:PSIVSD>CD X:MI="" "S X1=PSIVSD,X2=1 D C^%DTC S PSIVSD=X,Y=0" I MI,PSIVSD'