PSJLIVFD ;BIR/MV-SETUP LM TEMPLATE FOR IV FLUID ;14-Feb-2013 11:06;PB
;;5.0; INPATIENT MEDICATIONS ;**7,50,63,64,58,81,91,80,116,110,111,180,134,1015**;16 DEC 97;Build 62
;
; Reference to ^VALM0 is supported by DBIA # 2615.
;
;NFI changes for FR# 3@AD+4
;
; Modified - IHS/MSC/PB - 4/25/12 - added line tag OFFSET to display the Stability Offset Value field on the screen
;
; - IHS/MSC/PB - 2/13/13 - line OFFSET+5 modified to change the wording for the display line for the Beyond Use line
EN ; Build LM template to display IV order.
K ^TMP("PSJI",$J)
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,57,6)_$$TYPE^PSJLIUTL
NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG)
S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,6)
I '$D(IORVON),$D(IOST(0)) D ENS^%ZISS,TERM^VALM0
I $D(IORVON),(PSJVD]"") D CNTRL^VALM10(1,76,5,IORVON,IORVOFF,0) K PSJVD
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)_$$STARTDT^PSJLIUTL
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 ;
S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
D LONG^PSJLIUTL(P(8),22,24)
LASTREN ;
N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGRNDT D
. S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
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:$$STOPDT^PSJLIUTL)
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=$$ENDTC^PSGMI(PSGRFD) D
. 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),22,32) S PSJL=PSJL_$S(P(7):"@0 labels a day",1:"")
LASTFL ;
S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
S PSJL=PSJL_$$ENDTC^PSGMI(P("LF"))
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 ;
S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)_$P(P("OPI"),"^")
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)
IVROOM ;
S PSJL=""
S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2)
;D SETTMP^PSJLMPRU("PSJI",PSJL)
OFFSET ; IHS/MSC/PB - 4/25/12 added to display the Stability Offset and allow editing of this field
S FLAG=$G(^PS(59.5,+P("IVRM"),9999999))
I $G(P("OFFSET"))="",$P($G(^PS(53.1,+ON,9999999)),"^")="" D GETOFF
D:$G(FLAG)=1 FLDNO^PSJLIUTL("(12)",47)
;APSP/PB 4/25/12 line below modifed to disply the Beyond Use Date on the screen
;IHS/MSC/PB 2/13/13 - line below modified to change the way the Beyond Use line displays
;S:$G(FLAG)=1 PSJL=$$SETSTR^VALM1("Beyond Use Date:",PSJL,54,17)_"Today + "_$G(P("OFFSET"))
S:$G(FLAG)=1 PSJL=$$SETSTR^VALM1("Beyond Use Days:",PSJL,54,17)_$G(P("OFFSET"))
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="Order Checks :" D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,0)),22,60)
. 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,60)
.. D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
Q
;
SCHREQ(IVAR) ;
I $G(IVAR(4))="P"!($G(IVAR(23))="P")!($G(IVAR(5))) Q 1
Q 0
GETOFF ;IHS/MSC/PB - 4/25/12 Gets the minimum value for the stability offset from the DRG array
S MIN=31 F XDRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(DRG(XDRGT,DRGI)) Q:'DRGI I $P(DRG(XDRGT,DRGI),"^",7)<MIN S MIN=$P(DRG(XDRGT,DRGI),"^",7)
S P("OFFSET")=MIN
Q
PSJLIVFD ;BIR/MV-SETUP LM TEMPLATE FOR IV FLUID ;14-Feb-2013 11:06;PB
+1 ;;5.0; INPATIENT MEDICATIONS ;**7,50,63,64,58,81,91,80,116,110,111,180,134,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^VALM0 is supported by DBIA # 2615.
+4 ;
+5 ;NFI changes for FR# 3@AD+4
+6 ;
+7 ; Modified - IHS/MSC/PB - 4/25/12 - added line tag OFFSET to display the Stability Offset Value field on the screen
+8 ;
+9 ; - IHS/MSC/PB - 2/13/13 - line OFFSET+5 modified to change the wording for the display line for the Beyond Use line
EN ; Build LM template to display IV order.
+1 KILL ^TMP("PSJI",$JOB)
+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,57,6)_$$TYPE^PSJLIUTL
+6 NEW PSJVD
SET PSJVD=$$DINFLIV^PSJDIN(.DRG)
+7 SET PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,6)
+8 IF '$DATA(IORVON)
IF $DATA(IOST(0))
DO ENS^%ZISS
DO TERM^VALM0
+9 IF $DATA(IORVON)
IF (PSJVD]"")
DO CNTRL^VALM10(1,76,5,IORVON,IORVOFF,0)
KILL PSJVD
+10 DO SETTMP^PSJLMPRU("PSJI",PSJL)
+11 IF +$GET(PSJLMX)
DO CLRDSPL^PSJLIVMD
+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,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 SET PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^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 SET PSJL=""
DO FLDNO^PSJLIUTL("(3)",1)
+2 SET PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
+3 DO LONG^PSJLIUTL(P(8),22,24)
LASTREN ;
+1 NEW PSGRNDT
SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,$SELECT($GET(PSJORD):PSJORD,1:$GET(ON)))
IF PSGRNDT
Begin DoDot:1
+2 SET PSGRNDT=$$ENDTC^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 SET PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$SELECT($GET(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT^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 IF $GET(PSGRDTX(+PSJORD,"PSGRFD"))
SET PSGRFD=PSGRDTX(+PSJORD,"PSGRFD")
SET PSGRFDN=$$ENDTC^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),22,32)
SET PSJL=PSJL_$SELECT(P(7):"@0 labels a day",1:"")
LASTFL ;
+1 SET PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
+2 SET PSJL=PSJL_$$ENDTC^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 SET PSJL=""
DO FLDNO^PSJLIUTL("(10)",1)
+2 SET PSJL=$$SETSTR^VALM1("Other Print"_$SELECT($PIECE(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)_$PIECE(P("OPI"),"^")
+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)
IVROOM ;
+1 SET PSJL=""
+2 SET PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$PIECE(P("IVRM"),U,2)
+3 ;D SETTMP^PSJLMPRU("PSJI",PSJL)
OFFSET ; IHS/MSC/PB - 4/25/12 added to display the Stability Offset and allow editing of this field
+1 SET FLAG=$GET(^PS(59.5,+P("IVRM"),9999999))
+2 IF $GET(P("OFFSET"))=""
IF $PIECE($GET(^PS(53.1,+ON,9999999)),"^")=""
DO GETOFF
+3 IF $GET(FLAG)=1
DO FLDNO^PSJLIUTL("(12)",47)
+4 ;APSP/PB 4/25/12 line below modifed to disply the Beyond Use Date on the screen
+5 ;IHS/MSC/PB 2/13/13 - line below modified to change the way the Beyond Use line displays
+6 ;S:$G(FLAG)=1 PSJL=$$SETSTR^VALM1("Beyond Use Date:",PSJL,54,17)_"Today + "_$G(P("OFFSET"))
+7 IF $GET(FLAG)=1
SET PSJL=$$SETSTR^VALM1("Beyond Use Days:",PSJL,54,17)_$GET(P("OFFSET"))
+8 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="Order Checks :"
DO LONG^PSJLIUTL($GET(^PS(53.1,+ON,10,PSJIVX,0)),22,60)
+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,60)
+12 DO SETTMP^PSJLMPRU("PSJI",PSJL)
SET PSJL=""
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
SCHREQ(IVAR) ;
+1 IF $GET(IVAR(4))="P"!($GET(IVAR(23))="P")!($GET(IVAR(5)))
QUIT 1
+2 QUIT 0
GETOFF ;IHS/MSC/PB - 4/25/12 Gets the minimum value for the stability offset from the DRG array
+1 SET MIN=31
FOR XDRGT="AD","SOL"
FOR DRGI=0:0
SET DRGI=$ORDER(DRG(XDRGT,DRGI))
IF 'DRGI
QUIT
IF $PIECE(DRG(XDRGT,DRGI),"^",7)<MIN
SET MIN=$PIECE(DRG(XDRGT,DRGI),"^",7)
+2 SET P("OFFSET")=MIN
+3 QUIT
