- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLIVMD.m
r613 r623 1 PSJLIVMD ;BIR/MV-SETUP LM TEMPLATE FOR INPT MED. IV ;4 Aug 00 / 4:29 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**37,50,63,58,81,91,80,116,110,111,180,134**;16 DEC 97;Build 124 3 ; 4 ;Reference to ^PS(55 is supported by DBIA #2191. 5 ; 6 EN ; Build LM template to display IV order. 7 D GTOT^PSIVUTL(P(4)) 8 S:'$D(PSJSTAR) PSJSTAR="" S:'$D(PSGP) PSGP=DFN 9 I $E(P("OT"))'="I" D EN^PSJLIVFD Q 10 K ^TMP("PSJI",$J) 11 S UL80="",$P(UL80,"=",80)="" 12 S PSJLN=1 13 I $G(PSIV531),P("PON")["P" S (P(2),P(3),P(4))="" 14 AD ; 15 NEW VALMEVL S VALMEVL=1 16 S PSJL="" D FLDNO^PSJLIUTL("(1)",1) 17 S PSJL=PSJL_" Additives:" 18 S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,28,14)_+P("PON") 19 S PSJL=$$SETSTR^VALM1("Type:",PSJL,57,6)_$$TYPE^PSJLIUTL 20 NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG) 21 S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,6) 22 I $D(IORVON),(PSJVD]"") D CNTRL^VALM10(1,76,5,IORVON,IORVOFF,0) K PSJVD 23 D SETTMP^PSJLMPRU("PSJI",PSJL) 24 D:+$G(PSJLMX) CLRDSPL 25 ;PSJLMX count number of lines needed to display the add/sol 26 S PSJLMX=0 D WRTDRG^PSJLIUTL("AD") 27 SOL ; 28 S PSJL="" D FLDNO^PSJLIUTL("(2)",1) 29 S PSJL=PSJL_" Solutions:" 30 I P("SYRS")]"" D 31 . S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,11)_$E(P("SYRS"),1,13) 32 . S:$L(P("SYRS"))>13 PSJL=PSJL_"..." 33 D SETTMP^PSJLMPRU("PSJI",PSJL) 34 D WRTDRG^PSJLIUTL("SOL") 35 D DUR 36 START ; 37 NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN 38 I $G(P("OT"))="I",$G(P(4))]"" D 39 .Q:$G(ON)["V" I $G(PSIVAC)="" N PSIVAC S PSIVAC="CF" 40 .Q:$G(P(3)) 41 .D ENT^PSIVCAL,ENSTOP^PSIVCAL 42 D REQDT(ON) 43 D FLDNO^PSJLIUTL("(4)",47) 44 S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^PSJLIUTL 45 D SETTMP^PSJLMPRU("PSJI",PSJL) 46 INFRATE ; 47 S PSJL="" D FLDNO^PSJLIUTL("(3)",1) 48 S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15) 49 D LONG^PSJLIUTL(P(8),22,23) 50 RSTART ; 51 I $G(ON)["P" N PSGNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) D 52 . I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) Q 53 . Q:'$G(PSGRDTX) N PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN 54 . S RSDLABL=" REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN="" 55 . I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D 56 .. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc Start: " 57 . I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD) 58 . I $G(PSGRSD),($G(PSGRSDN)]"") D DSPLYDT(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL) ;,SETTMP^PSJLMPRU("PSJI",PSJL) 59 I $G(ON)["V" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) 60 I PSJL]"" D SETTMP^PSJLMPRU("PSJI",PSJL) 61 ; 62 MR ; 63 S PSJL="" D FLDNO^PSJLIUTL("(5)",1) 64 S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11) 65 S PSJL=PSJL_$P(P("MR"),U,2) 66 STOP ; 67 S:'$D(PSGP) PSGP=DFN 68 D FLDNO^PSJLIUTL("(6)",47) 69 ;PSJ*5*180 - If CPRS sends invalid duration/limit - Cannot Calculate Stop Date. 70 S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT^PSJLIUTL) 71 D SETTMP^PSJLMPRU("PSJI",PSJL) 72 S PSJL="" 73 N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSJORD) 74 I $G(PSJBCMA)]"",$G(DFN) S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52) 75 I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$G(P(3)) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")) D 76 . D DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29) 77 I ($G(PSJBCMA)]"")!($G(PSGRDTX(+$G(PSJORD),"PSGRFD"))&$G(P(3))) D SETTMP^PSJLMPRU("PSJI",PSJL) 78 SCH ; 79 S PSJL="" D FLDNO^PSJLIUTL("(7)",1) 80 S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11) 81 D LONG^PSJLIUTL(P(9)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,31) 82 LASTFL ; 83 S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11) 84 S PSJL=PSJL_$$ENDTC^PSGMI(P("LF")) 85 D SETTMP^PSJLMPRU("PSJI",PSJL) 86 ADM ; 87 S PSJL="" D FLDNO^PSJLIUTL("(8)",1) 88 S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14) 89 NEW NOECH 90 D LONG^PSJLIUTL(P(11),22,29) 91 QTY ; 92 S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA") 93 D SETTMP^PSJLMPRU("PSJI",PSJL) 94 PROVIDER ; 95 S PSJL="" D FLDNO^PSJLIUTL("(9)",1) 96 S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL 97 CUMDOSES ; 98 S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM") 99 D SETTMP^PSJLMPRU("PSJI",PSJL) 100 OI ; 101 S PSJL="" D FLDNO^PSJLIUTL("(10)",1) 102 S PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$P(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD")) 103 D SETTMP^PSJLMPRU("PSJI",PSJL) 104 INS ; 105 S PSJL="" 106 S PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14) 107 D LONG^PSJLIUTL(P("INS"),22,58) 108 D SETTMP^PSJLMPRU("PSJI",PSJL) 109 OPI ; 110 S PSJL="" D FLDNO^PSJLIUTL("(11)",1) 111 S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)_$P(P("OPI"),"^") 112 D SETTMP^PSJLMPRU("PSJI",PSJL) 113 PC ; 114 S PSJL="" 115 S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL 116 REMARK ; 117 D SETTMP^PSJLMPRU("PSJI","") 118 S PSJL="" D FLDNO^PSJLIUTL("(12)",1) 119 S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10) 120 D LONG^PSJLIUTL(P("REM"),18,62) 121 D SETTMP^PSJLMPRU("PSJI",PSJL) 122 IVROOM ; 123 S PSJL="" 124 S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2) 125 D SETTMP^PSJLMPRU("PSJI",PSJL) 126 ENTRY ; 127 S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10) 128 S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,24),1:"*** Undefined") 129 S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG")) 130 D SETTMP^PSJLMPRU("PSJI",PSJL) 131 S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D 132 . S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN 133 S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S($G(ON)["P":28,1:100))_" IV " 134 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)_")") 135 I $G(P("PON"))["P" D ORDCHK^PSJLIVFD 136 S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT 137 Q 138 DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ; 139 ;LINE : Line number the Requested Start and Stop dates are display in 140 ;PSGRDT : Either it is the requested start or stop date in FM format 141 ;PSGRDTN: Either it is the requested start or stop date in IPM format 142 ;TXT : The display text 143 ;PSJFSH : if it is 1 then flash 144 ; 145 S:'$G(PSJRDBEG) PSJRDBEG=41,PSJRDLEN=39 146 S PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN) 147 Q 148 CLRDSPL ; 149 ;Clear the blinking after edit the pending order. 150 ;Without it more than the requested start and stop dates are blinking at the ac/edit screen 151 ;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL 152 Q:'$D(IOBOFF) 153 NEW PSJX 154 F PSJX=5:1:PSJLMX+7 D CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM) 155 Q 156 REQDT(ORDER) ;Get requested date if it is a pending order 157 ;ORDER : Pending Order Number (PSJORD or PSGORD) 158 Q:ORDER'["P" D REQDT^PSJLIUTL(ORDER) 159 Q 160 ; 161 GETDUR(PAT,ORD,PKG,RAW) ; 162 ; PAT= Patient DFN 163 ; ORD= Order # 164 ; PKG= 5(UD), "IV"(IV), "P"(Pending) 165 N ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD S DUR="",ORD=+ORD K IVLIMIT 166 S:PKG="V" PKG="IV" 167 I PKG="P" S ND=$G(^PS(53.1,+ORD,0)) D I '$G(OLDORD) Q DUR 168 . I $G(P("OVRIDE")) S DUR="" Q 169 . D PENDING(ORD) Q:DUR]"" 170 . 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:"") 171 . Q:($G(OLDORD)'["P") 172 . D PENDING(OLDORD) S OLDORD="" 173 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 174 .N ACTND S ACTND=0 F S ACTND=$O(^PS(55,PAT,"IV",ORD,"A",ACTND)) Q:'ACTND D 175 ..I $G(^PS(55,PAT,"IV",ORD,"A",ACTND,0))["IV LIMIT OVERRIDDEN" S OLDORD="" 176 I $G(P("LIMIT"))]"" S DUR=P("LIMIT"),IVLIMIT=1 I '$G(RAW) S DUR=$$FMTDUR(DUR) Q DUR 177 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="" 178 S F25="^PS(55,PAT,PKG,ORD,2.5)" I '$G(OLDORD) Q:'$D(@(F25)) DUR 179 S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1 180 I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D 181 . S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1 182 I '$G(RAW),DUR]"" S DUR=$$FMTDUR(DUR) 183 Q DUR 184 ; 185 PENDING(PNDON) ; 186 S ND=$G(^PS(53.1,+ORD,0)) 187 I ND S ND25=$S(($P(ND,U,15)=PAT):$G(^PS(53.1,+ORD,2.5)),1:"") 188 S DUR=$P(ND25,U,4) I DUR]"" D Q 189 .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)) 190 S DUR=$P(ND25,U,2) I DUR]"" S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR)) 191 Q 192 ; 193 FMTDUR(DURCODE) ; 194 N DUNIT,DNUM,BAD S BAD=0 195 ;PSJ*5*180 - Add PSJBADD variable 196 K PSJBADD S PSJBADD=0 197 S DUNIT=$E(DURCODE),DNUM=$P(DURCODE,DUNIT,2) I 'DNUM S BAD=1 198 I DUNIT'="",DUNIT'?1(1U,1L) S PSJBADD=1 199 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:"") 200 S:DUNIT="" BAD=1 I (DNUM'=1),(DUNIT'["ml") S DUNIT=DUNIT_"s" 201 I PSJBADD=1 S PSGACT=$TR($G(PSGACT),"F") 202 Q $S(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT) 203 ; 204 DURMIN(DCOD) ; 205 N DUR,DMIN,CHR S DUR="" F I=1:1:$L(DCOD) S CHR=$E(DCOD,I) I CHR?1N S DUR=DUR_CHR 206 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) 207 Q DMIN 208 ; 209 DUR ; 210 N DUROUT,LABEL,IVLIMIT 211 Q:'$G(PSJORD) S PSJL="" 212 S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV")) 213 S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT 214 S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10) 215 S PSJL=PSJL_DUROUT 216 Q 1 PSJLIVMD ;BIR/MV-SETUP LM TEMPLATE FOR INPT MED. IV ;4 Aug 00 / 4:29 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**37,50,63,58,81,91,80,116,110,111,180**;16 DEC 97;Build 5 3 ; 4 ;Reference to ^PS(55 is supported by DBIA #2191. 5 ; 6 EN ; Build LM template to display IV order. 7 D GTOT^PSIVUTL(P(4)) 8 S:'$D(PSJSTAR) PSJSTAR="" S:'$D(PSGP) PSGP=DFN 9 I $E(P("OT"))'="I" D EN^PSJLIVFD Q 10 K ^TMP("PSJI",$J) 11 S UL80="",$P(UL80,"=",80)="" 12 S PSJLN=1 13 I $G(PSIV531),P("PON")["P" S (P(2),P(3),P(4))="" 14 AD ; 15 NEW VALMEVL S VALMEVL=1 16 S PSJL="" D FLDNO^PSJLIUTL("(1)",1) 17 S PSJL=PSJL_" Additives:" 18 S:$G(P("PON"))["V"&(P(17)'="N") PSJL=$$SETSTR^VALM1("Order number:",PSJL,28,14)_+P("PON") 19 S PSJL=$$SETSTR^VALM1("Type:",PSJL,57,6)_$$TYPE^PSJLIUTL 20 NEW PSJVD S PSJVD=$$DINFLIV^PSJDIN(.DRG) 21 S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,6) 22 I $D(IORVON),(PSJVD]"") D CNTRL^VALM10(1,76,5,IORVON,IORVOFF,0) K PSJVD 23 D SETTMP^PSJLMPRU("PSJI",PSJL) 24 D:+$G(PSJLMX) CLRDSPL 25 ;PSJLMX count number of lines needed to display the add/sol 26 S PSJLMX=0 D WRTDRG^PSJLIUTL("AD") 27 SOL ; 28 S PSJL="" D FLDNO^PSJLIUTL("(2)",1) 29 S PSJL=PSJL_" Solutions:" 30 I P("SYRS")]"" D 31 . S PSJL=$$SETSTR^VALM1("Syr. Size:",PSJL,52,11)_$E(P("SYRS"),1,13) 32 . S:$L(P("SYRS"))>13 PSJL=PSJL_"..." 33 D SETTMP^PSJLMPRU("PSJI",PSJL) 34 D WRTDRG^PSJLIUTL("SOL") 35 D DUR 36 START ; 37 NEW PSGRSD,PSGRSDN,PSGRFD,PSGRFDN 38 D REQDT(ON) 39 D FLDNO^PSJLIUTL("(4)",47) 40 S PSJL=$$SETSTR^VALM1("Start:",PSJL,56,7)_$$STARTDT^PSJLIUTL 41 D SETTMP^PSJLMPRU("PSJI",PSJL) 42 INFRATE ; 43 S PSJL="" D FLDNO^PSJLIUTL("(3)",1) 44 S PSJL=$$SETSTR^VALM1("Infusion Rate:",PSJL,7,15) 45 D LONG^PSJLIUTL(P(8),22,23) 46 RSTART ; 47 I $G(ON)["P" N PSGNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) D 48 . I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) Q 49 . Q:'$G(PSGRDTX) N PSJRQB,PSJRQL,RSDLABL,PSGRSD,PSGRSDN 50 . S RSDLABL=" REQUESTED START: ",PSJRQB=41,PSJRQL=39,PSGRSD="",PSGRSDN="" 51 . I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$G(P(2)) S PSJRQB=51,PSJRQL=29 D 52 .. S PSGRSD=PSGRDTX(+$G(PSJORD),"PSGRSD"),PSGRSDN=$$ENDTC^PSGMI(+PSGRSD),RSDLABL="Calc Start: " 53 . I '$G(P(2)),'$P(PSGRDTX,U,3) S PSGRSD=+PSGRDTX,PSGRSDN=$$ENDTC^PSGMI(PSGRSD) 54 . I $G(PSGRSD),($G(PSGRSDN)]"") D DSPLYDT(PSJLMX+5,.PSGRSD,.PSGRSDN,RSDLABL,1,PSJRQB,PSJRQL) ;,SETTMP^PSJLMPRU("PSJI",PSJL) 55 I $G(ON)["V" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,ON) I PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) 56 I PSJL]"" D SETTMP^PSJLMPRU("PSJI",PSJL) 57 ; 58 MR ; 59 S PSJL="" D FLDNO^PSJLIUTL("(5)",1) 60 S PSJL=$$SETSTR^VALM1("Med Route:",PSJL,11,11) 61 S PSJL=PSJL_$P(P("MR"),U,2) 62 STOP ; 63 S:'$D(PSGP) PSGP=DFN 64 D FLDNO^PSJLIUTL("(6)",47) 65 ;PSJ*5*180 - If CPRS sends invalid duration/limit - Cannot Calculate Stop Date. 66 S PSJL=$$SETSTR^VALM1("Stop:",PSJL,57,6)_$S($G(PSJBADD)=1:"CANNOT CALCULATE",1:$$STOPDT^PSJLIUTL) 67 D SETTMP^PSJLMPRU("PSJI",PSJL) 68 S PSJL="" 69 N PSJBCMA S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSJORD) 70 I $G(PSJBCMA)]"",$G(DFN) S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52) 71 I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$G(P(3)) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")) D 72 . D DSPLYDT(PSJLMX+7,.PSGRFD,.PSGRFDN," Calc Stop: ",1,51,29) 73 I ($G(PSJBCMA)]"")!($G(PSGRDTX(+$G(PSJORD),"PSGRFD"))&$G(P(3))) D SETTMP^PSJLMPRU("PSJI",PSJL) 74 SCH ; 75 S PSJL="" D FLDNO^PSJLIUTL("(7)",1) 76 S PSJL=$$SETSTR^VALM1("Schedule:",PSJL,12,11) 77 D LONG^PSJLIUTL(P(9)_$S(P(7):"@0 labels a day",1:"")_$G(SCHMSG),22,31) 78 LASTFL ; 79 S PSJL=$$SETSTR^VALM1("Last Fill:",PSJL,52,11) 80 S PSJL=PSJL_$$ENDTC^PSGMI(P("LF")) 81 D SETTMP^PSJLMPRU("PSJI",PSJL) 82 ADM ; 83 S PSJL="" D FLDNO^PSJLIUTL("(8)",1) 84 S PSJL=$$SETSTR^VALM1("Admin Times:",PSJL,9,14) 85 NEW NOECH 86 D LONG^PSJLIUTL(P(11),22,29) 87 QTY ; 88 S PSJL=$$SETSTR^VALM1("Quantity:",PSJL,53,10)_+P("LFA") 89 D SETTMP^PSJLMPRU("PSJI",PSJL) 90 PROVIDER ; 91 S PSJL="" D FLDNO^PSJLIUTL("(9)",1) 92 S PSJL=$$SETSTR^VALM1("Provider:",PSJL,12,10)_$$PROVIDER^PSJLIUTL 93 CUMDOSES ; 94 S PSJL=$$SETSTR^VALM1("Cum. Doses:",PSJL,51,12)_P("CUM") 95 D SETTMP^PSJLMPRU("PSJI",PSJL) 96 OI ; 97 S PSJL="" D FLDNO^PSJLIUTL("(10)",1) 98 S PSJL=$$SETSTR^VALM1("Orderable Item:",PSJL,6,16)_$P(P("PD"),U,2)_$$OINF^PSJDIN(+P("PD")) 99 D SETTMP^PSJLMPRU("PSJI",PSJL) 100 INS ; 101 S PSJL="" 102 S PSJL=$$SETSTR^VALM1("Instructions:",PSJL,8,14) 103 D LONG^PSJLIUTL(P("INS"),22,58) 104 D SETTMP^PSJLMPRU("PSJI",PSJL) 105 OPI ; 106 S PSJL="" D FLDNO^PSJLIUTL("(11)",1) 107 S PSJL=$$SETSTR^VALM1("Other Print"_$S($P(P("OPI"),"^",2)=1:"!: ",1:": "),PSJL,9,13)_$P(P("OPI"),"^") 108 D SETTMP^PSJLMPRU("PSJI",PSJL) 109 PC ; 110 S PSJL="" 111 S PSJL=$$SETSTR^VALM1("Provider Comments:",PSJL,3,18) D WTPC^PSJLIUTL 112 REMARK ; 113 D SETTMP^PSJLMPRU("PSJI","") 114 S PSJL="" D FLDNO^PSJLIUTL("(12)",1) 115 S PSJL=$$SETSTR^VALM1("Remarks :",PSJL,8,10) 116 D LONG^PSJLIUTL(P("REM"),18,62) 117 D SETTMP^PSJLMPRU("PSJI",PSJL) 118 IVROOM ; 119 S PSJL="" 120 S PSJL=$$SETSTR^VALM1("IV Room:",PSJL,9,9)_$P(P("IVRM"),U,2) 121 D SETTMP^PSJLMPRU("PSJI",PSJL) 122 ENTRY ; 123 S PSJL="",PSJL=$$SETSTR^VALM1("Entry By:",PSJL,8,10) 124 S PSJL=PSJL_$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,24),1:"*** Undefined") 125 S PSJL=$$SETSTR^VALM1("Entry Date:",PSJL,51,12)_$$ENDTC^PSGMI(P("LOG")) 126 D SETTMP^PSJLMPRU("PSJI",PSJL) 127 S PSJL="" S PSGLRN=$$LASTRNBY^PSJLMPRI(DFN,$S($G(PSJORD):PSJORD,1:$G(ON))) I PSGLRN D 128 . S PSJL=$$SETSTR^VALM1("Renewed By: ",PSJL,6,12)_$$ENNPN^PSGMI(PSGLRN) D SETTMP^PSJLMPRU("PSJI",PSJL) K PSGLRN 129 S VALM("TITLE")=$$CODES^PSIVUTL(P(17),$S($G(ON)["P":53.1,1:55.01),$S($G(ON)["P":28,1:100))_" IV " 130 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)_")") 131 I $G(P("PON"))["P" D ORDCHK^PSJLIVFD 132 S VALMCNT=PSJLN-1,^TMP("PSJI",$J,0)=VALMCNT 133 Q 134 DSPLYDT(PSJLN,PSGRDT,PSGRDTN,TXT,PSJFSH,PSJRDBEG,PSJRDLEN) ; 135 ;LINE : Line number the Requested Start and Stop dates are display in 136 ;PSGRDT : Either it is the requested start or stop date in FM format 137 ;PSGRDTN: Either it is the requested start or stop date in IPM format 138 ;TXT : The display text 139 ;PSJFSH : if it is 1 then flash 140 ; 141 S:'$G(PSJRDBEG) PSJRDBEG=41,PSJRDLEN=39 142 S PSJL=$$SETSTR^VALM1(TXT_PSGRDTN,PSJL,PSJRDBEG,PSJRDLEN) 143 Q 144 CLRDSPL ; 145 ;Clear the blinking after edit the pending order. 146 ;Without it more than the requested start and stop dates are blinking at the ac/edit screen 147 ;PSJLMX: # ad/sol counted in WRTDRG^PSJLIUTL 148 Q:'$D(IOBOFF) 149 NEW PSJX 150 F PSJX=5:1:PSJLMX+7 D CNTRL^VALM10(PSJX,36,80,IOBOFF,IOINORM) 151 Q 152 REQDT(ORDER) ;Get requested date if it is a pending order 153 ;ORDER : Pending Order Number (PSJORD or PSGORD) 154 Q:ORDER'["P" D REQDT^PSJLIUTL(ORDER) 155 Q 156 ; 157 GETDUR(PAT,ORD,PKG,RAW) ; 158 ; PAT= Patient DFN 159 ; ORD= Order # 160 ; PKG= 5(UD), "IV"(IV), "P"(Pending) 161 N ACT,DUR,ND,ND25,F25,ND0,ND2,OLDORD S DUR="",ORD=+ORD K IVLIMIT 162 S:PKG="V" PKG="IV" 163 I PKG="P" S ND=$G(^PS(53.1,+ORD,0)) D I '$G(OLDORD) Q DUR 164 . D PENDING(ORD) Q:DUR]"" 165 . 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:"") 166 . Q:($G(OLDORD)'["P") 167 . D PENDING(OLDORD) S OLDORD="" 168 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="" 169 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="" 170 S F25="^PS(55,PAT,PKG,ORD,2.5)" I '$G(OLDORD) Q:'$D(@(F25)) DUR 171 S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1 172 I DUR="",$G(OLDORD) S ORD=+OLDORD Q:'$D(@(F25)) DUR D 173 . S ND25=$G(@(F25)) S DUR=$P(ND25,U,2) I DUR="" S DUR=$P(ND25,U,4) I DUR]"" S IVLIMIT=1 174 I '$G(RAW),DUR]"" S DUR=$$FMTDUR(DUR) 175 Q DUR 176 ; 177 PENDING(PNDON) ; 178 S ND=$G(^PS(53.1,+ORD,0)) 179 I ND S ND25=$S(($P(ND,U,15)=PAT):$G(^PS(53.1,+ORD,2.5)),1:"") 180 S DUR=$P(ND25,U,4) I DUR]"" S:$E(DUR)="m"!($E(DUR)="l")!($E(DUR)="d")!($E(DUR)="h") IVLIMIT=1 S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR)) Q 181 S DUR=$P(ND25,U,2) I DUR]"" S DUR=$S($G(RAW):DUR,1:$$FMTDUR(DUR)) 182 Q 183 ; 184 FMTDUR(DURCODE) ; 185 N DUNIT,DNUM,BAD S BAD=0 186 ;PSJ*5*180 - Add PSJBADD variable 187 K PSJBADD S PSJBADD=0 188 S DUNIT=$E(DURCODE),DNUM=$P(DURCODE,DUNIT,2) I 'DNUM S BAD=1 189 I DUNIT'="",DUNIT'?1(1U,1L) S PSJBADD=1 190 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",1:"") 191 S:DUNIT="" BAD=1 I (DNUM'=1),(DUNIT'["ml") S DUNIT=DUNIT_"s" 192 I PSJBADD=1 S PSGACT=$TR($G(PSGACT),"F") 193 Q $S(PSJBADD=1:"*INVALID DURATION/LIMIT*",BAD:"",1:DNUM_DUNIT) 194 ; 195 DURMIN(DCOD) ; 196 N DUR,DMIN,CHR S DUR="" F I=1:1:$L(DCOD) S CHR=$E(DCOD,I) I CHR?1N S DUR=DUR_CHR 197 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) 198 Q DMIN 199 ; 200 DUR ; 201 N DUROUT,LABEL,IVLIMIT 202 Q:'$G(PSJORD) S PSJL="" 203 S DUROUT=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,$S(PSJORD["P":"P",1:"IV")) 204 S LABEL=$S($G(IVLIMIT):"IV Limit: ",1:"Duration: ") K IVLIMIT 205 S PSJL=$$SETSTR^VALM1(LABEL,PSJL,12,10) 206 S PSJL=PSJL_DUROUT 207 Q
Note:
See TracChangeset
for help on using the changeset viewer.
