- PSJLIVMD ;BIR/MV - SETUP LM TEMPLATE FOR INPT MED. IV ;Nov 10, 2020@14:17:02
- ;;5.0;INPATIENT MEDICATIONS;**37,50,63,58,81,91,80,116,110,111,180,134,209,254,267,275,279,373,319,399**;16 DEC 97;Build 64
- ;
- ;Reference to ^PS(55 is supported by DBIA #2191.
- ;
- EN ; Build LM template to display IV order.
- I $G(ON55),($G(P(1))=+$G(ON55)) S PSJORD=ON55
- D GTOT^PSIVUTL(P(4))
- S:'$D(PSJSTAR) PSJSTAR="" S:'$D(PSGP) PSGP=DFN
- I $E(P("OT"))'="I" D EN^PSJLIVFD Q
- K ^TMP("PSJI",$J)
- S UL80="",$P(UL80,"=",80)=""
- S PSJLN=1
- I $G(PSIV531),P("PON")["P" S (P(2),P(3),P(4))=""
- 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,28,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
- D SETTMP^PSJLMPRU("PSJI",PSJL)
- D:+$G(PSJLMX) CLRDSPL
- ;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,11)_$E(P("SYRS"),1,13)
- . S:$L(P("SYRS"))>13 PSJL=PSJL_"..."
- D SETTMP^PSJLMPRU("PSJI",PSJL)
- D WRTDRG^PSJLIUTL("SOL")
- D DUR
- START ;
- NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
- I $G(P("OT"))="I",$G(P(4))]"" D
- .I '$D(PSJSYSW0)!($$CLINIC^PSJO1($G(DFN),$G(ON))]"") N PSJSYSW0 S PSJSYSW0=$G(PSJSYSW0)
- .Q:$G(ON)["V" I $G(PSIVAC)="" N PSIVAC S PSIVAC="CF"
- .Q:$G(P(3))
- .D ENT^PSIVCAL,ENSTOP^PSIVCAL
- D REQDT(ON)
- D FLDNO^PSJLIUTL("(4)",47)
- S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL ;#373
- D 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,23)
- RSTART ;
- I $G(ON)["P" N PSGNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) D
- . I PSGRNDT S PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) Q ;#373
- . Q:'$G(PSGRDTX) N PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN
- . 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(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL) ;,SETTMP^PSJLMPRU("PSJI",PSJL)
- I $G(ON)["V" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) I PSGRNDT S PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) ;#373
- I PSJL]"" 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 ;
- S:'$D(PSGP) PSGP=DFN
- D FLDNO^PSJLIUTL("(6)",47)
- ;PSJ*5*180 - If CPRS sends 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(PSGP,PSJORD)
- I $G(PSJBCMA)]"",$G(DFN) S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
- I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$G(P(3)) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")) D
- . D DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29)
- I ($G(PSJBCMA)]"")!($G(PSGRDTX(+$G(PSJORD),"PSGRFD"))&$G(P(3))) D 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,31)
- 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)
- NEW NOECH
- D LONG^PSJLIUTL(P(11),22,29)
- 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)
- OI ;
- S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
- S PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$P(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD"))
- D SETTMP^PSJLMPRU("PSJI",PSJL)
- INS ;
- S PSJL=""
- S PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14)
- D LONG^PSJLIUTL(P("INS"),22,58)
- D SETTMP^PSJLMPRU("PSJI",PSJL)
- OPI ;
- S PSJL="" D FLDNO^PSJLIUTL("(11)",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="" Q
- .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=$O(^PS(53.45,$G(PSJSYSP),6,""),-1) 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="" Q
- .I PSJOPILN=1,$G(^PS(53.45,PSJSYSP,6,1,0))["Instructions too long. See Order View or BCMA for full text." K ^PS(53.45,PSJSYSP,6) S PSJOPILN="" Q
- .S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
- .S PSJL=PSJL_" "_$S(($G(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,DUZ,6,PSJOPCNT,0)) D SETTMP^PSJLMPRU("PSJI",PSJL)
- 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("(12)",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,24),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($G(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^PSJLIVFD
- S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
- Q
- DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ;
- ;LINE : Line number the Requested Start and Stop dates are display in
- ;PSGRDT : Either it is the requested start or stop date in FM format
- ;PSGRDTN: Either it is the requested start or stop date in IPM format
- ;TXT : The display text
- ;PSJFSH : if it is 1 then flash
- ;
- S:'$G(PSJRDBEG) PSJRDBEG=41,PSJRDLEN=39
- S PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN)
- Q
- CLRDSPL ;
- ;Clear the blinking after edit the pending order.
- ;Without it more than the requested start and stop dates are blinking at the ac/edit screen
- ;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL
- Q:'$D(IOBOFF)
- NEW PSJX
- F PSJX=5:1:PSJLMX+7 D CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM)
- Q
- REQDT(ORDER) ;Get requested date if it is a pending order
- ;ORDER : Pending Order Number (PSJORD or PSGORD)
- Q:ORDER'["P" D REQDT^PSJLIUTL(ORDER)
- Q
- ;
- GETDUR(PAT,ORD,PKG,RAW) ;
- ; PAT= Patient DFN
- ; ORD= Order #
- ; PKG= 5(UD), "IV"(IV), "P"(Pending)
- N ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD S DUR="",ORD=+ORD K IVLIMIT
- S:PKG="V" PKG="IV"
- I PKG="P" S ND=$G(^PS(53.1,+ORD,0)) D I '$G(OLDORD) Q DUR
- . I $G(P("OVRIDE")) S DUR="" Q
- . D PENDING(ORD) Q:DUR]""
- . S ND0=$G(^PS(53.1,ORD,0)) I $P(ND0,U,24)="E" S OLDORD=$P(ND0,U,25) I OLDORD S PKG=$S(OLDORD["V":"IV",OLDORD["U":5,OLDORD["P":"P",1:"")
- . Q:($G(OLDORD)'["P")
- . D PENDING(OLDORD) S OLDORD=""
- I PKG="IV" S ND2=$G(^PS(55,PAT,PKG,ORD,2)) I $P(ND2,U,8)="E" S OLDORD=$P(ND2,U,5) S:OLDORD'["V" OLDORD="" I OLDORD D
- .N ACTND S ACTND=0 F S ACTND=$O(^PS(55,PAT,"IV",ORD,"A",ACTND)) Q:'ACTND D
- ..I $G(^PS(55,PAT,"IV",ORD,"A",ACTND,0))["IV LIMIT OVERRIDDEN" S OLDORD=""
- I $G(P("LIMIT"))]"" S DUR=P("LIMIT"),IVLIMIT=1 I '$G(RAW) S DUR=$$FMTDUR(DUR) Q DUR
- I PKG=5 S ND0=$G(^PS(55,PAT,PKG,ORD,0)) I $P(ND0,U,24)="E" S OLDORD=$P(ND0,U,25) S:OLDORD'["U" OLDORD=""
- S F25="^PS(55,PAT,PKG,ORD,2.5)" I '$G(OLDORD) Q:'$D(@(F25)) DUR
- S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
- ;PSJ*5*209 stop forcing null duration to previous.
- ;I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D
- ;. S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
- I '$G(RAW),DUR]"" S DUR=$$FMTDUR(DUR)
- Q DUR
- ;
- PENDING(PNDON) ;
- S ND=$G(^PS(53.1,+ORD,0))
- I ND S ND25=$S(($P(ND,U,15)=PAT):$G(^PS(53.1,+ORD,2.5)),1:"")
- S DUR=$P(ND25,U,4) I DUR]"" D Q
- .S:($E(DUR)="s")!($E(DUR)="m")!($E(DUR)="l")!($E(DUR)="d")!($E(DUR)="h")!($E(DUR)="a") IVLIMIT=1 S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
- S DUR=$P(ND25,U,2) I DUR]"" S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
- Q
- ;
- FMTDUR(DURCODE) ;
- N DUNIT,DNUM,BAD S BAD=0
- ;PSJ*5*180 - Add PSJBADD variable
- K PSJBADD S PSJBADD=0
- S DUNIT=$E(DURCODE),DNUM=$P(DURCODE,DUNIT,2) I 'DNUM S BAD=1
- I DUNIT'="",DUNIT'?1(1U,1L) S PSJBADD=1
- S DUNIT=$S(DUNIT="D"!(DUNIT="d"):" day",DUNIT="H"!(DUNIT="h"):" hour",DUNIT="W":" week",DUNIT="L":" month",DUNIT="M":" minute",DUNIT="S":" second",DUNIT="m":" ml",DUNIT="l":" liter",DUNIT="a":" dose",1:"")
- S:DUNIT="" BAD=1 I (DNUM'=1),(DUNIT'["ml") S DUNIT=DUNIT_"s"
- I PSJBADD=1 S PSGACT=$TR($G(PSGACT),"F")
- Q $S(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT)
- ;
- DURMIN(DCOD) ;
- N DUR,DMIN,CHR S DUR="" F I=1:1:$L(DCOD) S CHR=$E(DCOD,I) I CHR?1N S DUR=DUR_CHR
- S DMIN=DUR*$S(DCOD["L":43200,DCOD["W":10080,DCOD["M":1,DCOD["S":(1/60),DCOD["D":1440,1:0) S DMIN=+$FN(DMIN,"",1)
- Q DMIN
- ;
- DUR ;
- N DUROUT,LABEL,IVLIMIT
- Q:'$G(PSJORD) S PSJL=""
- S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
- S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT
- S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
- S PSJL=PSJL_DUROUT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLIVMD 12234 printed Feb 18, 2025@23:33:48 Page 2
- PSJLIVMD ;BIR/MV - SETUP LM TEMPLATE FOR INPT MED. IV ;Nov 10, 2020@14:17:02
- +1 ;;5.0;INPATIENT MEDICATIONS;**37,50,63,58,81,91,80,116,110,111,180,134,209,254,267,275,279,373,319,399**;16 DEC 97;Build 64
- +2 ;
- +3 ;Reference to ^PS(55 is supported by DBIA #2191.
- +4 ;
- EN ; Build LM template to display IV order.
- +1 IF $GET(ON55)
- IF ($GET(P(1))=+$GET(ON55))
- SET PSJORD=ON55
- +2 DO GTOT^PSIVUTL(P(4))
- +3 if '$DATA(PSJSTAR)
- SET PSJSTAR=""
- if '$DATA(PSGP)
- SET PSGP=DFN
- +4 IF $EXTRACT(P("OT"))'="I"
- DO EN^PSJLIVFD
- QUIT
- +5 KILL ^TMP("PSJI",$JOB)
- +6 SET UL80=""
- SET $PIECE(UL80,"=",80)=""
- +7 SET PSJLN=1
- +8 IF $GET(PSIV531)
- IF P("PON")["P"
- SET (P(2),P(3),P(4))=""
- 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,28,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 DO SETTMP^PSJLMPRU("PSJI",PSJL)
- +11 if +$GET(PSJLMX)
- DO CLRDSPL
- +12 ;PSJLMX count number of lines needed to display the add/sol
- +13 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,11)_$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")
- +8 DO DUR
- START ;
- +1 NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
- +2 IF $GET(P("OT"))="I"
- IF $GET(P(4))]""
- Begin DoDot:1
- +3 IF '$DATA(PSJSYSW0)!($$CLINIC^PSJO1($GET(DFN),$GET(ON))]"")
- NEW PSJSYSW0
- SET PSJSYSW0=$GET(PSJSYSW0)
- +4 if $GET(ON)["V"
- QUIT
- IF $GET(PSIVAC)=""
- NEW PSIVAC
- SET PSIVAC="CF"
- +5 if $GET(P(3))
- QUIT
- +6 DO ENT^PSIVCAL
- DO ENSTOP^PSIVCAL
- End DoDot:1
- +7 DO REQDT(ON)
- +8 DO FLDNO^PSJLIUTL("(4)",47)
- +9 ;#373
- SET PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL
- +10 DO SETTMP^PSJLMPRU("PSJI",PSJL)
- 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,23)
- RSTART ;
- +1 IF $GET(ON)["P"
- NEW PSGNDT
- SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON)
- Begin DoDot:1
- +2 ;#373
- IF PSGRNDT
- SET PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT)
- SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
- QUIT
- +3 if '$GET(PSGRDTX)
- QUIT
- NEW PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN
- +4 SET RSDLABL=" REQUESTED START: "
- SET PSJRQB=41
- SET PSJRQL=39
- SET PSGRSD=""
- SET PSGRSDN=""
- +5 IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRSD"))
- IF $GET(P(2))
- SET PSJRQB=51
- SET PSJRQL=29
- Begin DoDot:2
- +6 SET PSGRSD=PSGRDTX(+$GET(PSJORD),"PSGRSD")
- SET PSGRSDN=$$ENDTC^PSGMI(+PSGRSD)
- SET RSDLABL="Calc Start: "
- End DoDot:2
- +7 IF '$GET(P(2))
- IF '$PIECE(PSGRDTX,U,3)
- SET PSGRSD=+PSGRDTX
- SET PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
- +8 ;,SETTMP^PSJLMPRU("PSJI",PSJL)
- IF $GET(PSGRSD)
- IF ($GET(PSGRSDN)]"")
- DO DSPLYDT(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL)
- End DoDot:1
- +9 ;#373
- IF $GET(ON)["V"
- NEW PSGRNDT
- SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON)
- IF PSGRNDT
- SET PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT)
- SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
- +10 IF PSJL]""
- DO SETTMP^PSJLMPRU("PSJI",PSJL)
- +11 ;
- 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 if '$DATA(PSGP)
- SET PSGP=DFN
- +2 DO FLDNO^PSJLIUTL("(6)",47)
- +3 ;PSJ*5*180 - If CPRS sends invalid duration/limit - Cannot Calculate Stop Date.
- +4 ;#373
- SET PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$SELECT($GET(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT2^PSJLIUTL)
- +5 DO SETTMP^PSJLMPRU("PSJI",PSJL)
- +6 SET PSJL=""
- +7 NEW PSJBCMA
- SET PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSJORD)
- +8 IF $GET(PSJBCMA)]""
- IF $GET(DFN)
- SET PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
- +9 IF $GET(PSJORD)["P"
- IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRFD"))
- IF $GET(P(3))
- SET PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD"))
- Begin DoDot:1
- +10 DO DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29)
- End DoDot:1
- +11 IF ($GET(PSJBCMA)]"")!($GET(PSGRDTX(+$GET(PSJORD),"PSGRFD"))&$GET(P(3)))
- 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,31)
- 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 NEW NOECH
- +4 DO LONG^PSJLIUTL(P(11),22,29)
- 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)
- OI ;
- +1 SET PSJL=""
- DO FLDNO^PSJLIUTL("(10)",1)
- +2 SET PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$PIECE(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD"))
- +3 DO SETTMP^PSJLMPRU("PSJI",PSJL)
- INS ;
- +1 SET PSJL=""
- +2 SET PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14)
- +3 DO LONG^PSJLIUTL(P("INS"),22,58)
- +4 DO SETTMP^PSJLMPRU("PSJI",PSJL)
- OPI ;
- +1 SET PSJL=""
- DO FLDNO^PSJLIUTL("(11)",1)
- +2 IF $GET(PSIVBR)["PSIVVW"
- Begin DoDot:1
- +3 SET PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD,1)
- +4 IF PSJOPILN=1
- IF ($TRANSLATE($GET(^TMP("PSJBCMA5",$JOB,DFN,PSJORD,1))," ")="")
- KILL ^TMP("PSJBCMA5",$JOB,DFN,PSJORD)
- SET PSJOPILN=""
- QUIT
- +5 SET PSJL=$$SETSTR^VALM1("Other Print"_$SELECT($PIECE(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
- +6 SET PSJL=PSJL_" "_$SELECT(($GET(PSJOPILN)>0):"(see below)",1:"")
- +7 DO SETTMP^PSJLMPRU("PSJI",PSJL)
- +8 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
- +9 IF $GET(PSIVBR)'["PSIVVW"
- Begin DoDot:1
- +10 IF $GET(ON55)["P"
- IF $GET(PSJORD)["V"
- IF $PIECE($GET(^PS(53.1,+ON55,0)),"^",25)=PSJORD
- SET PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,ON55)
- +11 SET PSJOPILN=$ORDER(^PS(53.45,$GET(PSJSYSP),6,""),-1)
- IF 'PSJOPILN
- SET PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD)
- +12 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=""
- QUIT
- +13 IF PSJOPILN=1
- IF $GET(^PS(53.45,PSJSYSP,6,1,0))["Instructions too long. See Order View or BCMA for full text."
- KILL ^PS(53.45,PSJSYSP,6)
- SET PSJOPILN=""
- QUIT
- +14 SET PSJL=$$SETSTR^VALM1("Other Print"_$SELECT($PIECE(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
- +15 SET PSJL=PSJL_" "_$SELECT(($GET(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,DUZ,6,PSJOPCNT,0))
- DO SETTMP^PSJLMPRU("PSJI",PSJL)
- End DoDot:1
- +18 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("(12)",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,24),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($GET(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^PSJLIVFD
- +10 SET VALMCNT=PSJLN-1
- SET ^TMP("PSJI",$JOB,0)=VALMCNT
- +11 QUIT
- DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ;
- +1 ;LINE : Line number the Requested Start and Stop dates are display in
- +2 ;PSGRDT : Either it is the requested start or stop date in FM format
- +3 ;PSGRDTN: Either it is the requested start or stop date in IPM format
- +4 ;TXT : The display text
- +5 ;PSJFSH : if it is 1 then flash
- +6 ;
- +7 if '$GET(PSJRDBEG)
- SET PSJRDBEG=41
- SET PSJRDLEN=39
- +8 SET PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN)
- +9 QUIT
- CLRDSPL ;
- +1 ;Clear the blinking after edit the pending order.
- +2 ;Without it more than the requested start and stop dates are blinking at the ac/edit screen
- +3 ;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL
- +4 if '$DATA(IOBOFF)
- QUIT
- +5 NEW PSJX
- +6 FOR PSJX=5:1:PSJLMX+7
- DO CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM)
- +7 QUIT
- REQDT(ORDER) ;Get requested date if it is a pending order
- +1 ;ORDER : Pending Order Number (PSJORD or PSGORD)
- +2 if ORDER'["P"
- QUIT
- DO REQDT^PSJLIUTL(ORDER)
- +3 QUIT
- +4 ;
- GETDUR(PAT,ORD,PKG,RAW) ;
- +1 ; PAT= Patient DFN
- +2 ; ORD= Order #
- +3 ; PKG= 5(UD), "IV"(IV), "P"(Pending)
- +4 NEW ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD
- SET DUR=""
- SET ORD=+ORD
- KILL IVLIMIT
- +5 if PKG="V"
- SET PKG="IV"
- +6 IF PKG="P"
- SET ND=$GET(^PS(53.1,+ORD,0))
- Begin DoDot:1
- +7 IF $GET(P("OVRIDE"))
- SET DUR=""
- QUIT
- +8 DO PENDING(ORD)
- if DUR]""
- QUIT
- +9 SET ND0=$GET(^PS(53.1,ORD,0))
- IF $PIECE(ND0,U,24)="E"
- SET OLDORD=$PIECE(ND0,U,25)
- IF OLDORD
- SET PKG=$SELECT(OLDORD["V":"IV",OLDORD["U":5,OLDORD["P":"P",1:"")
- +10 if ($GET(OLDORD)'["P")
- QUIT
- +11 DO PENDING(OLDORD)
- SET OLDORD=""
- End DoDot:1
- IF '$GET(OLDORD)
- QUIT DUR
- +12 IF PKG="IV"
- SET ND2=$GET(^PS(55,PAT,PKG,ORD,2))
- IF $PIECE(ND2,U,8)="E"
- SET OLDORD=$PIECE(ND2,U,5)
- if OLDORD'["V"
- SET OLDORD=""
- IF OLDORD
- Begin DoDot:1
- +13 NEW ACTND
- SET ACTND=0
- FOR
- SET ACTND=$ORDER(^PS(55,PAT,"IV",ORD,"A",ACTND))
- if 'ACTND
- QUIT
- Begin DoDot:2
- +14 IF $GET(^PS(55,PAT,"IV",ORD,"A",ACTND,0))["IV LIMIT OVERRIDDEN"
- SET OLDORD=""
- End DoDot:2
- End DoDot:1
- +15 IF $GET(P("LIMIT"))]""
- SET DUR=P("LIMIT")
- SET IVLIMIT=1
- IF '$GET(RAW)
- SET DUR=$$FMTDUR(DUR)
- QUIT DUR
- +16 IF PKG=5
- SET ND0=$GET(^PS(55,PAT,PKG,ORD,0))
- IF $PIECE(ND0,U,24)="E"
- SET OLDORD=$PIECE(ND0,U,25)
- if OLDORD'["U"
- SET OLDORD=""
- +17 SET F25="^PS(55,PAT,PKG,ORD,2.5)"
- IF '$GET(OLDORD)
- if '$DATA(@(F25))
- QUIT DUR
- +18 SET ND25=$GET(@(F25))
- SET DUR=$PIECE(ND25,U,2)
- IF DUR=""
- SET DUR=$PIECE(ND25,U,4)
- IF DUR]""
- SET IVLIMIT=1
- +19 ;PSJ*5*209 stop forcing null duration to previous.
- +20 ;I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D
- +21 ;. S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
- +22 IF '$GET(RAW)
- IF DUR]""
- SET DUR=$$FMTDUR(DUR)
- +23 QUIT DUR
- +24 ;
- PENDING(PNDON) ;
- +1 SET ND=$GET(^PS(53.1,+ORD,0))
- +2 IF ND
- SET ND25=$SELECT(($PIECE(ND,U,15)=PAT):$GET(^PS(53.1,+ORD,2.5)),1:"")
- +3 SET DUR=$PIECE(ND25,U,4)
- IF DUR]""
- Begin DoDot:1
- +4 if ($EXTRACT(DUR)="s")!($EXTRACT(DUR)="m")!($EXTRACT(DUR)="l")!($EXTRACT(DUR)="d")!($EXTRACT(DUR)="h")!($EXTRACT(DUR)="a")
- SET IVLIMIT=1
- SET DUR=$SELECT($GET(RAW):DUR,1:$$FMTDUR(DUR))
- End DoDot:1
- QUIT
- +5 SET DUR=$PIECE(ND25,U,2)
- IF DUR]""
- SET DUR=$SELECT($GET(RAW):DUR,1:$$FMTDUR(DUR))
- +6 QUIT
- +7 ;
- FMTDUR(DURCODE) ;
- +1 NEW DUNIT,DNUM,BAD
- SET BAD=0
- +2 ;PSJ*5*180 - Add PSJBADD variable
- +3 KILL PSJBADD
- SET PSJBADD=0
- +4 SET DUNIT=$EXTRACT(DURCODE)
- SET DNUM=$PIECE(DURCODE,DUNIT,2)
- IF 'DNUM
- SET BAD=1
- +5 IF DUNIT'=""
- IF DUNIT'?1(1U,1L)
- SET PSJBADD=1
- +6 SET DUNIT=$SELECT(DUNIT="D"!(DUNIT="d"):" day",DUNIT="H"!(DUNIT="h"):" hour",DUNIT="W":" week",DUNIT="L":" month",DUNIT="M":" minute",DUNIT="S":" second",DUNIT="m":" ml",DUNIT="l":" liter",DUNIT="a":" dose",1:"")
- +7 if DUNIT=""
- SET BAD=1
- IF (DNUM'=1)
- IF (DUNIT'["ml")
- SET DUNIT=DUNIT_"s"
- +8 IF PSJBADD=1
- SET PSGACT=$TRANSLATE($GET(PSGACT),"F")
- +9 QUIT $SELECT(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT)
- +10 ;
- DURMIN(DCOD) ;
- +1 NEW DUR,DMIN,CHR
- SET DUR=""
- FOR I=1:1:$LENGTH(DCOD)
- SET CHR=$EXTRACT(DCOD,I)
- IF CHR?1N
- SET DUR=DUR_CHR
- +2 SET DMIN=DUR*$SELECT(DCOD["L":43200,DCOD["W":10080,DCOD["M":1,DCOD["S":(1/60),DCOD["D":1440,1:0)
- SET DMIN=+$FNUMBER(DMIN,"",1)
- +3 QUIT DMIN
- +4 ;
- DUR ;
- +1 NEW DUROUT,LABEL,IVLIMIT
- +2 if '$GET(PSJORD)
- QUIT
- SET PSJL=""
- +3 SET DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$SELECT(PSJORD["P":"P",1:"IV"))
- +4 SET LABEL=$SELECT($GET(IVLIMIT):"IV Limit: ",1:"Duration: ")
- KILL IVLIMIT
- +5 SET PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
- +6 SET PSJL=PSJL_DUROUT
- +7 QUIT