Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJLIVFD

PSJLIVFD.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to ^VALM0 is supported by DBIA # 2615.
  1.  ;
  1.  ;NFI changes for FR# 3@AD+4
  1.  ;
  1.  ; Modified - IHS/MSC/PB - 4/25/12 - added line tag OFFSET to display the Stability Offset Value field on the screen
  1.  ;
  1.  ;          - IHS/MSC/PB - 2/13/13 - line OFFSET+5 modified to change the wording for the display line for the Beyond Use line
  1. EN ; Build LM template to display IV order.
  1.  K ^TMP("PSJI",$J)
  1.  S UL80="",$P(UL80,"=",80)=""
  1.  S PSJLN=1
  1.  NEW VALMEVL S VALMEVL=1
  1.  S PSJL="" D FLDNO^PSJLIUTL("(1)",1)
  1.  S PSJL=PSJL_"Additives:"
  1.  S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,30,14)_+P("PON")
  1.  S PSJL=$$SETSTR^VALM1("Type:",PSJL,57,6)_$$TYPE^PSJLIUTL
  1.  NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG)
  1.  S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,6)
  1.  I '$D(IORVON),$D(IOST(0)) D ENS^%ZISS,TERM^VALM0
  1.  I $D(IORVON),(PSJVD]"") D CNTRL^VALM10(1,76,5,IORVON,IORVOFF,0) K PSJVD
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  D:+$G(PSJLMX) CLRDSPL^PSJLIVMD
  1.  ;PSJLMX count number of lines needed to display the add/sol
  1.  S PSJLMX=0 D WRTDRG^PSJLIUTL("AD")
  1. SOL ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(2)",1)
  1.  S PSJL=PSJL_"Solutions:"
  1.  I P("SYRS")]"" D
  1.  . S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,10)_$E(P("SYRS"),1,13)
  1.  . S:$L(P("SYRS"))>13 PSJL=PSJL_"..."
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  D WRTDRG^PSJLIUTL("SOL")
  1. DUR ;
  1.  S PSJL=""
  1.  N DUROUT,IVLIMIT S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
  1.  I $G(PSJORD)["P" N ND25 S ND25=$G(^PS(53.1,+PSJORD,2.5)),IVLIMIT=$P(ND25,"^",4) D
  1.  .S IVLIMIT=$S(IVLIMIT]"":$$FMTDUR^PSJLIVMD(IVLIMIT),1:"") S:IVLIMIT]"" DUROUT=IVLIMIT
  1.  S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT
  1.  S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10)
  1.  S PSJL=PSJL_DUROUT
  1. START ;
  1.  D FLDNO^PSJLIUTL("(4)",47)
  1.  S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^PSJLIUTL
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
  1.  S PSJL="" I $G(PSJORD)["P",$G(PSGRDTX) D
  1.  . N RSDLABL,PSJRQB,PSJRQL,PSGRSD,PSGSRSDN
  1.  . S RSDLABL="     REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN=""
  1.  . I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D
  1.  .. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc Start: "
  1.  . I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
  1.  . I $G(PSGRSD),($G(PSGRSDN)]"") D DSPLYDT^PSJLIVMD(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL),SETTMP^PSJLMPRU("PSJI",PSJL)
  1. INFRATE ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
  1.  S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
  1.  D LONG^PSJLIUTL(P(8),22,24)
  1. LASTREN ;
  1.  N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGRNDT D
  1.  . S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. MR ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(5)",1)
  1.  S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11)
  1.  S PSJL=PSJL_$P(P("MR"),U,2)
  1. STOP ;
  1.  D FLDNO^PSJLIUTL("(6)",47)
  1.  ;PSJ*5*180 - If Invalid Duration/Limit - Cannot Calculate Stop Date
  1.  S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT^PSJLIUTL)
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  S PSJL=""
  1.  N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(DFN,PSJORD)
  1.  I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
  1.  I $G(PSGRDTX(+PSJORD,"PSGRFD")) S PSGRFD=PSGRDTX(+PSJORD,"PSGRFD"),PSGRFDN=$$ENDTC^PSGMI(PSGRFD) D
  1.  . D DSPLYDT^PSJLIVMD(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",0,51,29)
  1.  D:($G(PSJBCMA)]"")!($G(PSGRFD)]"") SETTMP^PSJLMPRU("PSJI",PSJL)
  1. SCH ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(7)",1)
  1.  S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11)
  1.  D LONG^PSJLIUTL(P(9),22,32) S PSJL=PSJL_$S(P(7):"@0 labels a day",1:"")
  1. LASTFL ;
  1.  S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
  1.  S PSJL=PSJL_$$ENDTC^PSGMI(P("LF"))
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. ADM ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(8)",1)
  1.  S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14)
  1.  D LONG^PSJLIUTL(P(11),22,30)
  1. QTY ;
  1.  S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA")
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. PROVIDER ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(9)",1)
  1.  S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL
  1. CUMDOSES ;
  1.  S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM")
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. OPI ;
  1.  S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
  1.  S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)_$P(P("OPI"),"^")
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. PC ;
  1.  S PSJL=""
  1.  S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL
  1. REMARK ;
  1.  D SETTMP^PSJLMPRU("PSJI","")
  1.  S PSJL="" D FLDNO^PSJLIUTL("(11)",1)
  1.  S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10)
  1.  D LONG^PSJLIUTL(P("REM"),18,62)
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. IVROOM ;
  1.  S PSJL=""
  1.  S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2)
  1.  ;D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. OFFSET ; IHS/MSC/PB - 4/25/12 added to display the Stability Offset and allow editing of this field
  1.  S FLAG=$G(^PS(59.5,+P("IVRM"),9999999))
  1.  I $G(P("OFFSET"))="",$P($G(^PS(53.1,+ON,9999999)),"^")="" D GETOFF
  1.  D:$G(FLAG)=1 FLDNO^PSJLIUTL("(12)",47)
  1.  ;APSP/PB 4/25/12 line below modifed to disply the Beyond Use Date on the screen
  1.  ;IHS/MSC/PB 2/13/13 - line below modified to change the way the Beyond Use line displays
  1.  ;S:$G(FLAG)=1 PSJL=$$SETSTR^VALM1("Beyond Use Date:",PSJL,54,17)_"Today + "_$G(P("OFFSET"))
  1.  S:$G(FLAG)=1 PSJL=$$SETSTR^VALM1("Beyond Use Days:",PSJL,54,17)_$G(P("OFFSET"))
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. ENTRY ;
  1.  S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10)
  1.  S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,18),1:"*** Undefined")
  1.  S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG"))
  1.  D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D
  1.  . S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN
  1.  S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S(ON["P":28,1:100))_" IV "
  1.  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)_")")
  1.  I $G(P("PON"))["P" D ORDCHK
  1.  S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
  1.  Q
  1.  ;
  1. ORDCHK ;Display order check for pending order
  1.  Q:'$O(^PS(53.1,+ON,10,0))
  1.  NEW PSJIVX,PSJIVXX
  1.  F PSJIVX=0:0 S PSJIVX=$O(^PS(53.1,+ON,10,PSJIVX)) Q:'PSJIVX  D
  1.  . D SETTMP^PSJLMPRU("PSJI","")
  1.  . S PSJL="Order Checks       :" D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,0)),22,60)
  1.  . D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  . S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+ON,10,PSJIVX,1)),U)
  1.  . D SETTMP^PSJLMPRU("PSJI",PSJL)
  1.  . S PSJL="Overriding Reason  : "
  1.  . F PSJIVXX=0:0 S PSJIVXX=$O(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX)) Q:'PSJIVXX  D
  1.  .. D LONG^PSJLIUTL($G(^PS(53.1,+ON,10,PSJIVX,2,PSJIVXX,0)),22,60)
  1.  .. D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
  1.  Q
  1.  ;
  1. SCHREQ(IVAR) ;
  1.  I $G(IVAR(4))="P"!($G(IVAR(23))="P")!($G(IVAR(5))) Q 1
  1.  Q 0
  1. GETOFF ;IHS/MSC/PB - 4/25/12 Gets the minimum value for the stability offset from the DRG array
  1.  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)
  1.  S P("OFFSET")=MIN
  1.  Q