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

PSJLIVMD.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to ^PS(55 is supported by DBIA #2191.
  1. ;
  1. EN ; Build LM template to display IV order.
  1. I $G(ON55),($G(P(1))=+$G(ON55)) S PSJORD=ON55
  1. D GTOT^PSIVUTL(P(4))
  1. S:'$D(PSJSTAR) PSJSTAR="" S:'$D(PSGP) PSGP=DFN
  1. I $E(P("OT"))'="I" D EN^PSJLIVFD Q
  1. K ^TMP("PSJI",$J)
  1. S UL80="",$P(UL80,"=",80)=""
  1. S PSJLN=1
  1. I $G(PSIV531),P("PON")["P" S (P(2),P(3),P(4))=""
  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,28,14)_+P("PON")
  1. S PSJL=$$SETSTR^VALM1("Type:",PSJL,54,6)_$$TYPE^PSJLIUTL
  1. NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG) S PSJVD=$TR(PSJVD," ")
  1. I $D(^TMP("PSJINTER",$J))!$$OVRCHK^PSGSICH1(PSGP,$G(PSJORD)) S PSJVD=$S($G(PSJVD)["DIN":"<OCI><DIN>",1:"<OCI>")
  1. S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$L(PSJVD)),$L(PSJVD))
  1. I $D(IORVON),($G(PSJVD)]"") D CNTRL^VALM10(1,(80-$L(PSJVD)),$L(PSJVD),IORVON,IORVOFF,0) K PSJVD
  1. D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. D:+$G(PSJLMX) CLRDSPL
  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,11)_$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. D DUR
  1. START ;
  1. NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN
  1. I $G(P("OT"))="I",$G(P(4))]"" D
  1. .I '$D(PSJSYSW0)!($$CLINIC^PSJO1($G(DFN),$G(ON))]"") N PSJSYSW0 S PSJSYSW0=$G(PSJSYSW0)
  1. .Q:$G(ON)["V" I $G(PSIVAC)="" N PSIVAC S PSIVAC="CF"
  1. .Q:$G(P(3))
  1. .D ENT^PSIVCAL,ENSTOP^PSIVCAL
  1. D REQDT(ON)
  1. D FLDNO^PSJLIUTL("(4)",47)
  1. S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT2^PSJLIUTL ;#373
  1. D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. INFRATE ;
  1. N INFLBL,INFLBL1,INFLBL2 S INFLBL="",INFLBL1="",$P(INFLBL2," ",20)=""
  1. S PSJL="" D FLDNO^PSJLIUTL("(3)",1)
  1. S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15)
  1. 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
  1. S INFLBL=$S('($G(P("NUMLBL"))?1.N):$P(P(8),"@"),1:$P(P(8),"@")_INFLBL1)
  1. D LONG^PSJLIUTL(INFLBL,22,23)
  1. RSTART ;
  1. I $G(ON)["P" N PSGNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) D
  1. . I PSGRNDT S PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) Q ;#373
  1. . Q:'$G(PSGRDTX) N PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN
  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(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL) ;,SETTMP^PSJLMPRU("PSJI",PSJL)
  1. 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
  1. I PSJL]"" D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. ;
  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. S:'$D(PSGP) PSGP=DFN
  1. D FLDNO^PSJLIUTL("(6)",47)
  1. ;PSJ*5*180 - If CPRS sends invalid duration/limit - Cannot Calculate Stop Date.
  1. S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT2^PSJLIUTL) ;#373
  1. D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. S PSJL=""
  1. N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSJORD)
  1. I $G(PSJBCMA)]"",$G(DFN) S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
  1. I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$G(P(3)) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")) D
  1. . D DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29)
  1. I ($G(PSJBCMA)]"")!($G(PSGRDTX(+$G(PSJORD),"PSGRFD"))&$G(P(3))) D 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)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,31)
  1. LASTFL ;
  1. S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11)
  1. S PSJL=PSJL_$$ENDTC2^PSGMI(P("LF")) ;#373
  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. NEW NOECH
  1. D LONG^PSJLIUTL(P(11),22,29)
  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. OI ;
  1. S PSJL="" D FLDNO^PSJLIUTL("(10)",1)
  1. S PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$P(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD"))
  1. D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. INS ;
  1. S PSJL=""
  1. S PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14)
  1. D LONG^PSJLIUTL(P("INS"),22,58)
  1. D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. OPI ;
  1. S PSJL="" D FLDNO^PSJLIUTL("(11)",1)
  1. I $G(PSIVBR)["PSIVVW" D
  1. .S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD,1)
  1. .I PSJOPILN=1,($TR($G(^TMP("PSJBCMA5",$J,DFN,PSJORD,1))," ")="") K ^TMP("PSJBCMA5",$J,DFN,PSJORD) S PSJOPILN="" Q
  1. .S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
  1. .S PSJL=PSJL_" "_$S(($G(PSJOPILN)>0):"(see below)",1:"")
  1. .D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. .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)
  1. I $G(PSIVBR)'["PSIVVW" D
  1. .I $G(ON55)["P",$G(PSJORD)["V",$P($G(^PS(53.1,+ON55,0)),"^",25)=PSJORD S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,ON55)
  1. .S PSJOPILN=$O(^PS(53.45,$G(PSJSYSP),6,""),-1) I 'PSJOPILN S PSJOPILN=$$GETSIOPI^PSJBCMA5(DFN,PSJORD)
  1. .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
  1. .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
  1. .S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)
  1. .S PSJL=PSJL_" "_$S(($G(PSJOPILN)>0)&'($G(^PS(53.45,PSJSYSP,6,0))<0):"(see below)",1:"")
  1. .D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. .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)
  1. K PSJOPILN,PSJOPCNT
  1. IND ;*399-IND
  1. S PSJL="" D FLDNO^PSJLIUTL("(14)",1)
  1. S PSJL=$$SETSTR^VALM1("Indication:",PSJL,10,12)_P("IND")
  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("(12)",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. CLNVST ; *p319
  1. I ($G(P("CLIN")))&($G(P("APPT"))) D
  1. .S PSJL="" D FLDNO^PSJLIUTL("(15)",1)
  1. .S PSJL=$$SETSTR^VALM1("Visit Location:",PSJL,6,16)
  1. .S PSJL=PSJL_$P($G(^SC(P("CLIN"),0)),U)
  1. .D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. .S PSJL="" D FLDNO^PSJLIUTL("(16)",1)
  1. .S PSJL=$$SETSTR^VALM1("Visit Date:",PSJL,10,12)
  1. .S PSJL=PSJL_$$ENDTC2^PSGMI(P("APPT"))
  1. .D SETTMP^PSJLMPRU("PSJI",PSJL)
  1. .S PSJL="" 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. 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,24),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($G(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^PSJLIVFD
  1. S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT
  1. Q
  1. DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ;
  1. ;LINE : Line number the Requested Start and Stop dates are display in
  1. ;PSGRDT : Either it is the requested start or stop date in FM format
  1. ;PSGRDTN: Either it is the requested start or stop date in IPM format
  1. ;TXT : The display text
  1. ;PSJFSH : if it is 1 then flash
  1. ;
  1. S:'$G(PSJRDBEG) PSJRDBEG=41,PSJRDLEN=39
  1. S PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN)
  1. Q
  1. CLRDSPL ;
  1. ;Clear the blinking after edit the pending order.
  1. ;Without it more than the requested start and stop dates are blinking at the ac/edit screen
  1. ;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL
  1. Q:'$D(IOBOFF)
  1. NEW PSJX
  1. F PSJX=5:1:PSJLMX+7 D CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM)
  1. Q
  1. REQDT(ORDER) ;Get requested date if it is a pending order
  1. ;ORDER : Pending Order Number (PSJORD or PSGORD)
  1. Q:ORDER'["P" D REQDT^PSJLIUTL(ORDER)
  1. Q
  1. ;
  1. GETDUR(PAT,ORD,PKG,RAW) ;
  1. ; PAT= Patient DFN
  1. ; ORD= Order #
  1. ; PKG= 5(UD), "IV"(IV), "P"(Pending)
  1. N ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD S DUR="",ORD=+ORD K IVLIMIT
  1. S:PKG="V" PKG="IV"
  1. I PKG="P" S ND=$G(^PS(53.1,+ORD,0)) D I '$G(OLDORD) Q DUR
  1. . I $G(P("OVRIDE")) S DUR="" Q
  1. . D PENDING(ORD) Q:DUR]""
  1. . 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:"")
  1. . Q:($G(OLDORD)'["P")
  1. . D PENDING(OLDORD) S OLDORD=""
  1. 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
  1. .N ACTND S ACTND=0 F S ACTND=$O(^PS(55,PAT,"IV",ORD,"A",ACTND)) Q:'ACTND D
  1. ..I $G(^PS(55,PAT,"IV",ORD,"A",ACTND,0))["IV LIMIT OVERRIDDEN" S OLDORD=""
  1. I $G(P("LIMIT"))]"" S DUR=P("LIMIT"),IVLIMIT=1 I '$G(RAW) S DUR=$$FMTDUR(DUR) Q DUR
  1. 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=""
  1. S F25="^PS(55,PAT,PKG,ORD,2.5)" I '$G(OLDORD) Q:'$D(@(F25)) DUR
  1. S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
  1. ;PSJ*5*209 stop forcing null duration to previous.
  1. ;I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D
  1. ;. S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1
  1. I '$G(RAW),DUR]"" S DUR=$$FMTDUR(DUR)
  1. Q DUR
  1. ;
  1. PENDING(PNDON) ;
  1. S ND=$G(^PS(53.1,+ORD,0))
  1. I ND S ND25=$S(($P(ND,U,15)=PAT):$G(^PS(53.1,+ORD,2.5)),1:"")
  1. S DUR=$P(ND25,U,4) I DUR]"" D Q
  1. .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))
  1. S DUR=$P(ND25,U,2) I DUR]"" S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR))
  1. Q
  1. ;
  1. FMTDUR(DURCODE) ;
  1. N DUNIT,DNUM,BAD S BAD=0
  1. ;PSJ*5*180 - Add PSJBADD variable
  1. K PSJBADD S PSJBADD=0
  1. S DUNIT=$E(DURCODE),DNUM=$P(DURCODE,DUNIT,2) I 'DNUM S BAD=1
  1. I DUNIT'="",DUNIT'?1(1U,1L) S PSJBADD=1
  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:"")
  1. S:DUNIT="" BAD=1 I (DNUM'=1),(DUNIT'["ml") S DUNIT=DUNIT_"s"
  1. I PSJBADD=1 S PSGACT=$TR($G(PSGACT),"F")
  1. Q $S(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT)
  1. ;
  1. DURMIN(DCOD) ;
  1. N DUR,DMIN,CHR S DUR="" F I=1:1:$L(DCOD) S CHR=$E(DCOD,I) I CHR?1N S DUR=DUR_CHR
  1. 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)
  1. Q DMIN
  1. ;
  1. DUR ;
  1. N DUROUT,LABEL,IVLIMIT
  1. Q:'$G(PSJORD) S PSJL=""
  1. S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV"))
  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. Q