PSJLIVFD ;BIR/MV - SETUP LM TEMPLATE FOR IV FLUID ;Nov 10, 2020@14:09:48
;;5.0;INPATIENT MEDICATIONS;**7,50,63,64,58,81,91,80,116,110,111,180,134,181,254,267,228,279,305,256,373,319,399**;16 DEC 97;Build 64
;
; External Reference to ^VALM0 is supported by DBIA #2615.
; External Referece to ^PS(53.47 is supported by DBIA #5884
;
;NFI changes for FR# 3@AD+4
;
EN ; Build LM template to display IV order.
K ^TMP("PSJI",$J) N SCHMSG
S UL80="",$P(UL80,"=",80)=""
S PSJLN=1
AD ;
NEW VALMEVL S VALMEVL=1
S PSJL="" D FLDNO^PSJLIUTL("(1)",1)
S PSJL=PSJL_"Additives:"
S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,30,14)_+P("PON")
S PSJL=$$SETSTR^VALM1("Type:",PSJL,54,6)_$$TYPE^PSJLIUTL
NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG) S PSJVD=$TR(PSJVD," ")
I $D(^TMP("PSJINTER",$J))!$$OVRCHK^PSGSICH1(PSGP,$G(PSJORD)) S PSJVD=$S($G(PSJVD)["DIN":"<OCI><DIN>",1:"<OCI>")
S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$L(PSJVD)),$L(PSJVD))
I $D(IORVON),($G(PSJVD)]"") D CNTRL^VALM10(1,(80-$L(PSJVD)),$L(PSJVD),IORVON,IORVOFF,0) K PSJVD
I '$D(IORVON),$D(IOST(0)) D ENS^%ZISS,TERM^VALM0
D SETTMP^PSJLMPRU("PSJI",PSJL)
D:+$G(PSJLMX) CLRDSPL^PSJLIVMD
;PSJLMX count number of lines needed to display the add/sol
S PSJLMX=0 D WRTDRG^PSJLIUTL("AD")
SOL ;
S PSJL="" D FLDNO^PSJLIUTL("(2)",1)
S PSJL=PSJL_"Solutions:"
I P("SYRS")]"" D
. S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,10)_$E(P("SYRS"),1,13)
. S:$L(P("SYRS"))>13 PSJL=PSJL_"..."
D SETTMP^PSJLMPRU("PSJI",PSJL)
D WRTDRG^PSJLIUTL("SOL")
DUR ;
S PSJL=""
N DUROUT,IVLIMIT S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
I $G(PSJORD)["P" N ND25 S ND25=$G(^PS(53.1,+PSJORD,2.5)),IVLIMIT=$P(ND25,"^",4) D
.S IVLIMIT=$S(IVLIMIT]"":$$FMTDUR^PSJLIVMD(IVLIMIT),1:"") S:IVLIMIT]"" DUROUT=IVLIMIT
S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT
S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
S PSJL=PSJL_DUROUT
START ;
D FLDNO^PSJLIUTL("(4)",47)
S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL ;373
D SETTMP^PSJLMPRU("PSJI",PSJL)
NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
S PSJL="" I $G(PSJORD)["P",$G(PSGRDTX) D
. N RSDLABL,PSJRQB,PSJRQL,PSGRSD,PSGSRSDN
. S RSDLABL=" REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN=""
. I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D
.. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc Start: "
. I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
. I $G(PSGRSD),($G(PSGRSDN)]"") D DSPLYDT^PSJLIVMD(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL),SETTMP^PSJLMPRU("PSJI",PSJL)
INFRATE ;
N INFLBL,INFLBL1,INFLBL2 S INFLBL="",INFLBL1="",$P(INFLBL2," ",20)=""
S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
I ($G(P("NUMLBL"))?1.N) S INFLBL1=" ("_P("NUMLBL")_" label"_$S(P("NUMLBL")=1:"",1:"s")_" per day)" I $L(P(8))>13 S INFLBL1=$E(INFLBL2,1,(24-$L(P(8))))_INFLBL1
S INFLBL=$S('($G(P("NUMLBL"))?1.N):$P(P(8),"@"),1:$P(P(8),"@")_INFLBL1)
D LONG^PSJLIUTL(INFLBL,22,24)
LASTREN ;
N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGRNDT D
. S PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) ;#373
D SETTMP^PSJLMPRU("PSJI",PSJL)
MR ;
S PSJL="" D FLDNO^PSJLIUTL("(5)",1)
S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11)
S PSJL=PSJL_$P(P("MR"),U,2)
STOP ;
D FLDNO^PSJLIUTL("(6)",47)
;PSJ*5*180 - If Invalid Duration/Limit - Cannot Calculate Stop Date
S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT2^PSJLIUTL) ;#373
D SETTMP^PSJLMPRU("PSJI",PSJL)
S PSJL=""
N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(DFN,PSJORD)
I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
I $G(PSGRDTX(+PSJORD,"PSGRFD")) S PSGRFD=PSGRDTX(+PSJORD,"PSGRFD"),PSGRFDN=$$ENDTC2^PSGMI(PSGRFD) D ;#373
. D DSPLYDT^PSJLIVMD(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",0,51,29)
D:($G(PSJBCMA)]"")!($G(PSGRFD)]"") SETTMP^PSJLMPRU("PSJI",PSJL)
SCH ;
S PSJL="" D FLDNO^PSJLIUTL("(7)",1)
S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11)
D LONG^PSJLIUTL(P(9)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,35)
LASTFL ;
S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
S PSJL=PSJL_$$ENDTC2^PSGMI(P("LF")) ;#373
D SETTMP^PSJLMPRU("PSJI",PSJL)
ADM ;
S PSJL="" D FLDNO^PSJLIUTL("(8)",1)
S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14)
D LONG^PSJLIUTL(P(11),22,30)
QTY ;
S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA")
D SETTMP^PSJLMPRU("PSJI",PSJL)
PROVIDER ;
S PSJL="" D FLDNO^PSJLIUTL("(9)",1)
S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL
CUMDOSES ;
S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM")
D SETTMP^PSJLMPRU("PSJI",PSJL)
OPI ;
N PSJOPILN,PSJOPCNT
S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
I $G(PSIVBR)["PSIVVW" D
.S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD,1)
.I PSJOPILN=1,($TR($G(^TMP("PSJBCMA5",$J,DFN,PSJORD,1))," ")="") K ^TMP("PSJBCMA5",$J,DFN,PSJORD) S PSJOPILN=""
.S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
.S PSJL=PSJL_" "_$S(($G(PSJOPILN)>0):"(see below)",1:"")
.D SETTMP^PSJLMPRU("PSJI",PSJL)
.I (PSJOPILN>0) N PSJOPCNT S PSJOPCNT=0 F PSJOPCNT=1:1:PSJOPILN S PSJL=" "_$G(^TMP("PSJBCMA5",$J,DFN,PSJORD,PSJOPCNT)) D SETTMP^PSJLMPRU("PSJI",PSJL)
I $G(PSIVBR)'["PSIVVW" D
.I $G(ON55)["P",$G(PSJORD)["V",$P($G(^PS(53.1,+ON55,0)),"^",25)=PSJORD S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,ON55)
.S PSJOPILN=$P($G(^PS(53.45,PSJSYSP,6,0)),"^",3) I 'PSJOPILN S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD)
.I PSJOPILN=1,($TR($G(^PS(53.45,PSJSYSP,6,1,0))," ")="") I '($G(^PS(53.45,PSJSYSP,6,0))<0) K ^PS(53.45,PSJSYSP,6) S PSJOPILN=""
.S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
.S PSJL=PSJL_$S((PSJOPILN>0)&'($G(^PS(53.45,PSJSYSP,6,0))<0):"(see below)",1:"")
.D SETTMP^PSJLMPRU("PSJI",PSJL)
.I PSJOPILN>0 N PSJOPCNT S PSJOPCNT=0 F PSJOPCNT=1:1:PSJOPILN S PSJL=" "_$G(^PS(53.45,PSJSYSP,6,PSJOPCNT,0)) D SETTMP^PSJLMPRU("PSJI",PSJL)
K PSJOPILN,PSJOPCNT K PSJOPILN,PSJOPCNT
IND ;*399-IND
S PSJL="" D FLDNO^PSJLIUTL("(14)",1)
S PSJL=$$SETSTR^VALM1("Indication:",PSJL,10,12)_P("IND")
D SETTMP^PSJLMPRU("PSJI",PSJL)
PC ;
S PSJL=""
S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL
D SETTMP^PSJLMPRU("PSJI","")
S PSJL="" D FLDNO^PSJLIUTL("(11)",1)
S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10)
D LONG^PSJLIUTL(P("REM"),18,62)
D SETTMP^PSJLMPRU("PSJI",PSJL)
CLNVST ; *p319
I ($G(P("CLIN")))&($G(P("APPT"))) D
.S PSJL="" D FLDNO^PSJLIUTL("(15)",1)
.S PSJL=$$SETSTR^VALM1("Visit Location:",PSJL,6,16)
.S PSJL=PSJL_$P($G(^SC(P("CLIN"),0)),U)
.D SETTMP^PSJLMPRU("PSJI",PSJL)
.S PSJL="" D FLDNO^PSJLIUTL("(16)",1)
.S PSJL=$$SETSTR^VALM1("Visit Date:",PSJL,10,12)
.S PSJL=PSJL_$$ENDTC2^PSGMI(P("APPT"))
.D SETTMP^PSJLMPRU("PSJI",PSJL)
.S PSJL="" D SETTMP^PSJLMPRU("PSJI",PSJL)
IVROOM ;
S PSJL=""
S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2)
D SETTMP^PSJLMPRU("PSJI",PSJL)
ENTRY ;
S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10)
S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,18),1:"*** Undefined")
S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG"))
D SETTMP^PSJLMPRU("PSJI",PSJL)
S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D
. S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN
S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S(ON["P":28,1:100))_" IV "
I $G(P("PRY"))="D"!($G(P("PON"))["P") S VALM("TITLE")=VALM("TITLE")_$S($G(P("PRY"))="":"",1:"("_$$CODES^PSIVUTL(P("PRY"),53.1,.24)_")")
I $G(P("PON"))["P" D ORDCHK
S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
Q
;
ORDCHK ;Display order check for pending order
Q:'$O(^PS(53.1,+ON,10,0))
NEW PSJIVX,PSJIVXX
F PSJIVX=0:0 S PSJIVX=$O(^PS(53.1,+ON,10,PSJIVX)) Q:'PSJIVX D
. D SETTMP^PSJLMPRU("PSJI","")
. S PSJL="CPRS Order Checks :" D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,0)),22,58)
. D SETTMP^PSJLMPRU("PSJI",PSJL)
. S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+ON,10,PSJIVX,1)),U)
. D SETTMP^PSJLMPRU("PSJI",PSJL)
. S PSJL="Overriding Reason : "
. F PSJIVXX=0:0 S PSJIVXX=$O(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX)) Q:'PSJIVXX D
.. D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX,0)),22,58)
.. D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
Q
;
SCHREQ(IVAR) ; Intermittent IV's require a schedule
I $G(IVAR(4))="P"!($G(IVAR(23))="P")!($G(IVAR(5))) Q 1
Q 0
;
INFCHK(INFFULL,INFEXP) ; Parse and expand infusion rate
;*305
Q:INFFULL=""
S INFEXP=INFFULL
N I S I=$O(^PS(53.47,"B",INFFULL,0)) Q:'I S:$P($G(^PS(53.47,I,0)),"^",2)]"" INFEXP=$P(^(0),"^",2)
Q
INFEXP(INF) ; Expand Infusion Rate
I $L(INF)<1!($L(INF)>30) Q INF
N INFIEN,ARRAY
S (INFIEN,ARRAY)=""
N X,Y,DIC,DR,DA,DIQ
S X=INF,DIC(0)="XO",DIC="^PS(53.47," D ^DIC I '($G(Y)>0) Q INF
S INFIEN=+$G(Y)
D GETS^DIQ(53.47,INFIEN_",",".01;1","E","ARRAY")
I $G(ARRAY("53.47",INFIEN_",","1","E"))]"" Q ARRAY("53.47",INFIEN_",","1","E")
Q INF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLIVFD 9302 printed Apr 09, 2024@21:04 Page 2
PSJLIVFD ;BIR/MV - SETUP LM TEMPLATE FOR IV FLUID ;Nov 10, 2020@14:09:48
+1 ;;5.0;INPATIENT MEDICATIONS;**7,50,63,64,58,81,91,80,116,110,111,180,134,181,254,267,228,279,305,256,373,319,399**;16 DEC 97;Build 64
+2 ;
+3 ; External Reference to ^VALM0 is supported by DBIA #2615.
+4 ; External Referece to ^PS(53.47 is supported by DBIA #5884
+5 ;
+6 ;NFI changes for FR# 3@AD+4
+7 ;
EN ; Build LM template to display IV order.
+1 KILL ^TMP("PSJI",$JOB)
NEW SCHMSG
+2 SET UL80=""
SET $PIECE(UL80,"=",80)=""
+3 SET PSJLN=1
AD ;
+1 NEW VALMEVL
SET VALMEVL=1
+2 SET PSJL=""
DO FLDNO^PSJLIUTL("(1)",1)
+3 SET PSJL=PSJL_"Additives:"
+4 if $GET(P("PON"))["V"&(P(17)'="N")
SET PSJL=$$SETSTR^VALM1("Order number:",PSJL,30,14)_+P("PON")
+5 SET PSJL=$$SETSTR^VALM1("Type:",PSJL,54,6)_$$TYPE^PSJLIUTL
+6 NEW PSJVD
SET PSJVD=$$DINFLIV^PSJDIN(.DRG)
SET PSJVD=$TRANSLATE(PSJVD," ")
+7 IF $DATA(^TMP("PSJINTER",$JOB))!$$OVRCHK^PSGSICH1(PSGP,$GET(PSJORD))
SET PSJVD=$SELECT($GET(PSJVD)["DIN":"<OCI><DIN>",1:"<OCI>")
+8 SET PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$LENGTH(PSJVD)),$LENGTH(PSJVD))
+9 IF $DATA(IORVON)
IF ($GET(PSJVD)]"")
DO CNTRL^VALM10(1,(80-$LENGTH(PSJVD)),$LENGTH(PSJVD),IORVON,IORVOFF,0)
KILL PSJVD
+10 IF '$DATA(IORVON)
IF $DATA(IOST(0))
DO ENS^%ZISS
DO TERM^VALM0
+11 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+12 if +$GET(PSJLMX)
DO CLRDSPL^PSJLIVMD
+13 ;PSJLMX count number of lines needed to display the add/sol
+14 SET PSJLMX=0
DO WRTDRG^PSJLIUTL("AD")
SOL ;
+1 SET PSJL=""
DO FLDNO^PSJLIUTL("(2)",1)
+2 SET PSJL=PSJL_"Solutions:"
+3 IF P("SYRS")]""
Begin DoDot:1
+4 SET PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,10)_$EXTRACT(P("SYRS"),1,13)
+5 if $LENGTH(P("SYRS"))>13
SET PSJL=PSJL_"..."
End DoDot:1
+6 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+7 DO WRTDRG^PSJLIUTL("SOL")
DUR ;
+1 SET PSJL=""
+2 NEW DUROUT,IVLIMIT
SET DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$SELECT(PSJORD["P":"P",1:"IV"))
+3 IF $GET(PSJORD)["P"
NEW ND25
SET ND25=$GET(^PS(53.1,+PSJORD,2.5))
SET IVLIMIT=$PIECE(ND25,"^",4)
Begin DoDot:1
+4 SET IVLIMIT=$SELECT(IVLIMIT]"":$$FMTDUR^PSJLIVMD(IVLIMIT),1:"")
if IVLIMIT]""
SET DUROUT=IVLIMIT
End DoDot:1
+5 SET LABEL=$SELECT($GET(IVLIMIT):"IV Limit: ",1:"Duration: ")
KILL IVLIMIT
+6 SET PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
+7 SET PSJL=PSJL_DUROUT
START ;
+1 DO FLDNO^PSJLIUTL("(4)",47)
+2 ;373
SET PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL
+3 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+4 NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
+5 SET PSJL=""
IF $GET(PSJORD)["P"
IF $GET(PSGRDTX)
Begin DoDot:1
+6 NEW RSDLABL,PSJRQB,PSJRQL,PSGRSD,PSGSRSDN
+7 SET RSDLABL=" REQUESTED START: "
SET PSJRQB=41
SET PSJRQL=39
SET PSGRSD=""
SET PSGRSDN=""
+8 IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRSD"))
IF $GET(P(2))
SET PSJRQB=51
SET PSJRQL=29
Begin DoDot:2
+9 SET PSGRSD=PSGRDTX(+$GET(PSJORD),"PSGRSD")
SET PSGRSDN=$$ENDTC^PSGMI(+PSGRSD)
SET RSDLABL="Calc Start: "
End DoDot:2
+10 IF '$GET(P(2))
IF '$PIECE(PSGRDTX,U,3)
SET PSGRSD=+PSGRDTX
SET PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
+11 IF $GET(PSGRSD)
IF ($GET(PSGRSDN)]"")
DO DSPLYDT^PSJLIVMD(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL)
DO SETTMP^PSJLMPRU("PSJI",PSJL)
End DoDot:1
INFRATE ;
+1 NEW INFLBL,INFLBL1,INFLBL2
SET INFLBL=""
SET INFLBL1=""
SET $PIECE(INFLBL2," ",20)=""
+2 SET PSJL=""
DO FLDNO^PSJLIUTL("(3)",1)
+3 SET PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
+4 IF ($GET(P("NUMLBL"))?1.N)
SET INFLBL1=" ("_P("NUMLBL")_" label"_$SELECT(P("NUMLBL")=1:"",1:"s")_" per day)"
IF $LENGTH(P(8))>13
SET INFLBL1=$EXTRACT(INFLBL2,1,(24-$LENGTH(P(8))))_INFLBL1
+5 SET INFLBL=$SELECT('($GET(P("NUMLBL"))?1.N):$PIECE(P(8),"@"),1:$PIECE(P(8),"@")_INFLBL1)
+6 DO LONG^PSJLIUTL(INFLBL,22,24)
LASTREN ;
+1 NEW PSGRNDT
SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,$SELECT($GET(PSJORD):PSJORD,1:$GET(ON)))
IF PSGRNDT
Begin DoDot:1
+2 ;#373
SET PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT)
SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
End DoDot:1
+3 DO SETTMP^PSJLMPRU("PSJI",PSJL)
MR ;
+1 SET PSJL=""
DO FLDNO^PSJLIUTL("(5)",1)
+2 SET PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11)
+3 SET PSJL=PSJL_$PIECE(P("MR"),U,2)
STOP ;
+1 DO FLDNO^PSJLIUTL("(6)",47)
+2 ;PSJ*5*180 - If Invalid Duration/Limit - Cannot Calculate Stop Date
+3 ;#373
SET PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$SELECT($GET(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT2^PSJLIUTL)
+4 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+5 SET PSJL=""
+6 NEW PSJBCMA
SET PSJBCMA=$$BCMALG^PSJUTL2(DFN,PSJORD)
+7 IF $GET(PSJBCMA)]""
SET PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
+8 ;#373
IF $GET(PSGRDTX(+PSJORD,"PSGRFD"))
SET PSGRFD=PSGRDTX(+PSJORD,"PSGRFD")
SET PSGRFDN=$$ENDTC2^PSGMI(PSGRFD)
Begin DoDot:1
+9 DO DSPLYDT^PSJLIVMD(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",0,51,29)
End DoDot:1
+10 if ($GET(PSJBCMA)]"")!($GET(PSGRFD)]"")
DO SETTMP^PSJLMPRU("PSJI",PSJL)
SCH ;
+1 SET PSJL=""
DO FLDNO^PSJLIUTL("(7)",1)
+2 SET PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11)
+3 DO LONG^PSJLIUTL(P(9)_$SELECT(P(7):"@0 labels a day",1:"")_$GET(SCHMSG),22,35)
LASTFL ;
+1 SET PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
+2 ;#373
SET PSJL=PSJL_$$ENDTC2^PSGMI(P("LF"))
+3 DO SETTMP^PSJLMPRU("PSJI",PSJL)
ADM ;
+1 SET PSJL=""
DO FLDNO^PSJLIUTL("(8)",1)
+2 SET PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14)
+3 DO LONG^PSJLIUTL(P(11),22,30)
QTY ;
+1 SET PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA")
+2 DO SETTMP^PSJLMPRU("PSJI",PSJL)
PROVIDER ;
+1 SET PSJL=""
DO FLDNO^PSJLIUTL("(9)",1)
+2 SET PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL
CUMDOSES ;
+1 SET PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM")
+2 DO SETTMP^PSJLMPRU("PSJI",PSJL)
OPI ;
+1 NEW PSJOPILN,PSJOPCNT
+2 SET PSJL=""
DO FLDNO^PSJLIUTL("(10)",1)
+3 IF $GET(PSIVBR)["PSIVVW"
Begin DoDot:1
+4 SET PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD,1)
+5 IF PSJOPILN=1
IF ($TRANSLATE($GET(^TMP("PSJBCMA5",$JOB,DFN,PSJORD,1))," ")="")
KILL ^TMP("PSJBCMA5",$JOB,DFN,PSJORD)
SET PSJOPILN=""
+6 SET PSJL=$$SETSTR^VALM1("Other Print"_$SELECT($PIECE(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
+7 SET PSJL=PSJL_" "_$SELECT(($GET(PSJOPILN)>0):"(see below)",1:"")
+8 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+9 IF (PSJOPILN>0)
NEW PSJOPCNT
SET PSJOPCNT=0
FOR PSJOPCNT=1:1:PSJOPILN
SET PSJL=" "_$GET(^TMP("PSJBCMA5",$JOB,DFN,PSJORD,PSJOPCNT))
DO SETTMP^PSJLMPRU("PSJI",PSJL)
End DoDot:1
+10 IF $GET(PSIVBR)'["PSIVVW"
Begin DoDot:1
+11 IF $GET(ON55)["P"
IF $GET(PSJORD)["V"
IF $PIECE($GET(^PS(53.1,+ON55,0)),"^",25)=PSJORD
SET PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,ON55)
+12 SET PSJOPILN=$PIECE($GET(^PS(53.45,PSJSYSP,6,0)),"^",3)
IF 'PSJOPILN
SET PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD)
+13 IF PSJOPILN=1
IF ($TRANSLATE($GET(^PS(53.45,PSJSYSP,6,1,0))," ")="")
IF '($GET(^PS(53.45,PSJSYSP,6,0))<0)
KILL ^PS(53.45,PSJSYSP,6)
SET PSJOPILN=""
+14 SET PSJL=$$SETSTR^VALM1("Other Print"_$SELECT($PIECE(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
+15 SET PSJL=PSJL_$SELECT((PSJOPILN>0)&'($GET(^PS(53.45,PSJSYSP,6,0))<0):"(see below)",1:"")
+16 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+17 IF PSJOPILN>0
NEW PSJOPCNT
SET PSJOPCNT=0
FOR PSJOPCNT=1:1:PSJOPILN
SET PSJL=" "_$GET(^PS(53.45,PSJSYSP,6,PSJOPCNT,0))
DO SETTMP^PSJLMPRU("PSJI",PSJL)
End DoDot:1
+18 KILL PSJOPILN,PSJOPCNT
KILL PSJOPILN,PSJOPCNT
IND ;*399-IND
+1 SET PSJL=""
DO FLDNO^PSJLIUTL("(14)",1)
+2 SET PSJL=$$SETSTR^VALM1("Indication:",PSJL,10,12)_P("IND")
+3 DO SETTMP^PSJLMPRU("PSJI",PSJL)
PC ;
+1 SET PSJL=""
+2 SET PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18)
DO WTPC^PSJLIUTL
+1 DO SETTMP^PSJLMPRU("PSJI","")
+2 SET PSJL=""
DO FLDNO^PSJLIUTL("(11)",1)
+3 SET PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10)
+4 DO LONG^PSJLIUTL(P("REM"),18,62)
+5 DO SETTMP^PSJLMPRU("PSJI",PSJL)
CLNVST ; *p319
+1 IF ($GET(P("CLIN")))&($GET(P("APPT")))
Begin DoDot:1
+2 SET PSJL=""
DO FLDNO^PSJLIUTL("(15)",1)
+3 SET PSJL=$$SETSTR^VALM1("Visit Location:",PSJL,6,16)
+4 SET PSJL=PSJL_$PIECE($GET(^SC(P("CLIN"),0)),U)
+5 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+6 SET PSJL=""
DO FLDNO^PSJLIUTL("(16)",1)
+7 SET PSJL=$$SETSTR^VALM1("Visit Date:",PSJL,10,12)
+8 SET PSJL=PSJL_$$ENDTC2^PSGMI(P("APPT"))
+9 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+10 SET PSJL=""
DO SETTMP^PSJLMPRU("PSJI",PSJL)
End DoDot:1
IVROOM ;
+1 SET PSJL=""
+2 SET PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$PIECE(P("IVRM"),U,2)
+3 DO SETTMP^PSJLMPRU("PSJI",PSJL)
ENTRY ;
+1 SET PSJL=""
SET PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10)
+2 SET PSJL=PSJL_$SELECT($PIECE(P("CLRK"),U,2)]"":$EXTRACT($PIECE(P("CLRK"),U,2),1,18),1:"*** Undefined")
+3 SET PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG"))
+4 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+5 SET PSJL=""
SET PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$SELECT($GET(PSJORD):PSJORD,1:$GET(ON)))
IF PSGLRN
Begin DoDot:1
+6 SET PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN)
DO SETTMP^PSJLMPRU("PSJI",PSJL)
KILL PSGLRN
End DoDot:1
+7 SET VALM("TITLE")=$$CODES^PSIVUTL(P(17),$SELECT($GET(ON)["P":53.1,1:55.01),$SELECT(ON["P":28,1:100))_" IV "
+8 IF $GET(P("PRY"))="D"!($GET(P("PON"))["P")
SET VALM("TITLE")=VALM("TITLE")_$SELECT($GET(P("PRY"))="":"",1:"("_$$CODES^PSIVUTL(P("PRY"),53.1,.24)_")")
+9 IF $GET(P("PON"))["P"
DO ORDCHK
+10 SET VALMCNT=PSJLN-1
SET ^TMP("PSJI",$JOB,0)=VALMCNT
+11 QUIT
+12 ;
ORDCHK ;Display order check for pending order
+1 if '$ORDER(^PS(53.1,+ON,10,0))
QUIT
+2 NEW PSJIVX,PSJIVXX
+3 FOR PSJIVX=0:0
SET PSJIVX=$ORDER(^PS(53.1,+ON,10,PSJIVX))
if 'PSJIVX
QUIT
Begin DoDot:1
+4 DO SETTMP^PSJLMPRU("PSJI","")
+5 SET PSJL="CPRS Order Checks :"
DO LONG^PSJLIUTL($GET(^PS(53.1,+ON,10,PSJIVX,0)),22,58)
+6 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+7 SET PSJL="Overriding Provider: "_$PIECE($GET(^PS(53.1,+ON,10,PSJIVX,1)),U)
+8 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+9 SET PSJL="Overriding Reason : "
+10 FOR PSJIVXX=0:0
SET PSJIVXX=$ORDER(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX))
if 'PSJIVXX
QUIT
Begin DoDot:2
+11 DO LONG^PSJLIUTL($GET(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX,0)),22,58)
+12 DO SETTMP^PSJLMPRU("PSJI",PSJL)
SET PSJL=""
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
SCHREQ(IVAR) ; Intermittent IV's require a schedule
+1 IF $GET(IVAR(4))="P"!($GET(IVAR(23))="P")!($GET(IVAR(5)))
QUIT 1
+2 QUIT 0
+3 ;
INFCHK(INFFULL,INFEXP) ; Parse and expand infusion rate
+1 ;*305
+2 if INFFULL=""
QUIT
+3 SET INFEXP=INFFULL
+4 NEW I
SET I=$ORDER(^PS(53.47,"B",INFFULL,0))
if 'I
QUIT
if $PIECE($GET(^PS(53.47,I,0)),"^",2)]""
SET INFEXP=$PIECE(^(0),"^",2)
+5 QUIT
INFEXP(INF) ; Expand Infusion Rate
+1 IF $LENGTH(INF)<1!($LENGTH(INF)>30)
QUIT INF
+2 NEW INFIEN,ARRAY
+3 SET (INFIEN,ARRAY)=""
+4 NEW X,Y,DIC,DR,DA,DIQ
+5 SET X=INF
SET DIC(0)="XO"
SET DIC="^PS(53.47,"
DO ^DIC
IF '($GET(Y)>0)
QUIT INF
+6 SET INFIEN=+$GET(Y)
+7 DO GETS^DIQ(53.47,INFIEN_",",".01;1","E","ARRAY")
+8 IF $GET(ARRAY("53.47",INFIEN_",","1","E"))]""
QUIT ARRAY("53.47",INFIEN_",","1","E")
+9 QUIT INF
