- 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 Jan 18, 2025@03:08:38 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