PSJLMUDE ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM
;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175,201**;16 DEC 97;Build 2
;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
;also chgs @init+23
;
; Reference to ^PS(55 is supported by DBIA# 2191
; Reference to ^PSDRUG is supported by DBIA 2192
;
INIT(PSGP,PSGORD) ;
N D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR K ^TMP("PSJUDE",$J)
K:$G(PSJNORD) PSGOEEF S PSJLN=1
D CLEAN^VALM10
S PSJL=$S($D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:" "),PSJL=$$SETSTR^VALM1("Orderable Item: "_PSGPDN_$$OINF^PSJDIN(PSGPD),PSJL,5,74) D D SETTMP D:$G(PSGOEEF(108))!($G(PSGOEEF(101))) HILITE(1)
. NEW Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q S PSJDDA(+$G(^(Q,0)))=""
. S PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)
. S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)
. D:PSJVD]"" CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)
I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)
S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)
S PSJL=$S($D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:" "),PSJL=$$SETSTR^VALM1("Dosage Ordered: "_PSGDO,PSJL,5,76) D SETTMP D:$G(PSGOEEF(109)) HILITE(2)
I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
I $G(PSJORD),($G(PSJDUR)="") S P=$S(PSJORD["U":5,PSJORD["V":"IV",PSJORD["P":"P",1:-1) S PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,P)
S PSJL=$$SETSTR^VALM1("Duration: "_$G(PSJDUR),PSJL,11,25)
S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_$P(PSGSDN,U,2),PSJL,54,26) D:$G(PSGOEEF(10)) HILITE(3)
I $G(PSGORD)["P" N ND0,OLDO S ND0=@(PSGOEEWF_"0)") I $P(ND0,"^",24)="R" S OLDO=$P(ND0,"^",25) I OLDO,(OLDO["U") D
. N OSTRT,OSTRTN S OSTRT=$G(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)")),OSTRT=$P(OSTRT,"^",2) Q:'OSTRT S OSTRTN=$$ENDTC^PSGMI(+OSTRT)
. S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_OSTRTN,PSJL,54,26)
D SETTMP
S PSJL=$S($D(PSGEFN(4)):$E(" *",PSGEFN(4)+1)_"(4)",1:" "),PSJL=$$SETSTR^VALM1("Med Route: "_PSGMRN,PSJL,10,35) D:$G(PSGOEEF(3)) HILITE(4)
I $G(PSJORD)["P" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD) S:PSGRNDT PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
I '$G(PSGRNDT),$G(PSGRDTX) D
. I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,48,32) Q
. I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$P($G(PSGSDN),U,2) S PSGRSDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRSD")),PSJL=$$SETSTR^VALM1("Calc Start: "_PSGRSDN,PSJL,53,32) D
.. I PSGSD'=PSGRDTX(+PSJORD,"PSGRSD") D CNTRL^VALM10(5,53,80,IORVON,IORVOFF)
; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference
I $G(PSJORD)["U" N ND14 S ND14=$G(@(PSGOEEWF_"14,0)")) I ND14]"" S ND14=$G(^($P(ND14,"^",3),0)),RNDT=$P(ND14,"^") I RNDT D
. N PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
D SETTMP
I PSGORD]"" S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" ")_" Stop: "_$P(PSGFDN,U,2),PSJL,54,26) D SETTMP D:$G(PSGOEEF(25))!($G(PSGOEEF(34))) HILITE(5)
S PSJL=$S($D(PSGEFN(6)):$E(" *",PSGEFN(6)+1)_"(6)",1:" "),PSJL=$$SETSTR^VALM1("Schedule Type: "_PSGSTN,PSJL,6,45) D:$G(PSGOEEF(7)) HILITE(6)
I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$P($G(PSGFDN),U,2) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")),PSJL=$$SETSTR^VALM1("Calc Stop: "_PSGRFDN,PSJL,54,26) D
. I PSGFD'=PSGRDTX(+PSJORD,"PSGRFD") D CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
D SETTMP
S PSGSMN=$P("NO^YES",U,PSGSM+1)
S PSJL=$S($D(PSGEFN(8)):$E(" *",PSGEFN(8)+1)_"(8)",1:" "),PSJL=$$SETSTR^VALM1("Schedule: "_PSGSCH_$G(SCHMSG),PSJL,11,68) D SETTMP D:$G(PSGOEEF(26)) HILITE(8)
S PSJL=$S($D(PSGEFN(9)):$E(" *",PSGEFN(9)+1)_"(9)",1:" "),PSJL=$$SETSTR^VALM1("Admin Times: "_PSGAT,PSJL,8,71) D SETTMP D:$G(PSGOEEF(39))!($G(PSGOEEF(41))) HILITE(9)
S PSJL=$S($D(PSGEFN(10)):$E(" *",PSGEFN(10)+1)_"(10)",1:" "),PSJL=$$SETSTR^VALM1("Provider: "_PSGPRN,PSJL,11,68) D:$G(PSGOEEF(1)) HILITE(10) D SETTMP
;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:" ")_"Self Med: "_PSGSMN,PSJL,56,24) S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1(" (HS)",PSJL,71,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
S PSJL=$S($D(PSGEFN(11)):$E(" *",PSGEFN(11))_"(11)",1:" ")_" Special Instructions"_$S($P(PSGSI,"^",2)=1:"!: ",1:": ")_$P(PSGSI,"^") D PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80)
S PSJL="" D SETTMP D:$G(PSGOEEF(8)) HILITE(11)
; E3R 16130
I $O(^PS(53.45,PSJSYSP,2,1)) F S PSJL="" D SETTMP Q:PSJLN>15
S PSJL=$S($D(PSGEFN(12)):$E(" *",PSGEFN(12))_" (12)",1:" ")_" Dispense Drug",PSJL=$$SETSTR^VALM1("U/D",PSJL,54,60),PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,65,16) D SETTMP,CNTRL^VALM10(13,1,80,IOUON,IOUOFF,0)
;S $P(PSJL,"-",80)="" D SETTMP
NEW PSJX
F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q S ND=$G(^(Q,0)) D
.S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
.S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(")
.S PSJL=" "_D_$$DDNF^PSJDIN(+ND),PSJL=$$SETSTR^VALM1($S($P(ND,"^",2):$S($P(ND,"^",2)=.5:"1/2",$P(ND,"^",2)=.25:"1/4",1:$P(ND,"^",2)),$P(ND,"^",2)=0:0,1:1),PSJL,54,63) S:PSGID PSJL=$$SETSTR^VALM1(PSGID,PSJL,65,16) D D SETTMP
..S PSJX=$G(PSJX)+1
..I $G(PSGOEEF(109)) D CNTRL^VALM10(13+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)
I $S(PSGORD["P":$O(^PS(53.1,+$G(PSGORD),12,0)),1:$O(^PS(55,PSGP,5,+PSGORD,12,0))) S PSJL="Provider Comments:" D SETTMP S PSJL="" D
.F Q=0:0 S Q=$S(PSGORD["P":$O(^PS(53.1,+$G(PSGORD),12,Q)),1:$O(^PS(55,PSGP,5,+PSGORD,12,Q))) Q:'Q S PSJL=$G(^(Q,0)) D SETTMP
D SETTMP S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:" ")_"Self Med: "_PSGSMN,PSJL,1,24)
S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1(" (HS)",PSJL,16,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
D SETTMP S PSJL="Entry By: "_PSGEBN,PSJL=$$SETSTR^VALM1("Entry Date: "_$P(PSGLIN,U,2),PSJL,51,39) D SETTMP
I $G(PSGLRN) D SETTMP S PSJL="Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2)) D SETTMP
D SETTMP S PSJL="(13)"_" Comments:"
D:'$O(^PS(53.45,PSJSYSP,1,0)) SETTMP
D SETTMP F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,1,Q)) Q:'Q S PSJWPL=PSJL_$S($E(PSJL)=" ":"",1:" ")_$G(^(Q,0)),PSJL="" D DISPLAY
D SETTMP
I PSGORD["P",($P($G(^PS(53.1,+PSGORD,0)),U,9)="P"),$O(^PS(53.1,+PSGORD,10,0)) D
.D SETTMP S PSJL="Order Checks:" D SETTMP
.F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,10,Q)) Q:'Q D
..S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) D SETTMP
..S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+PSGORD,10,Q,1)),U) D SETTMP
..S PSJL="Overriding Reason: " F X=0:0 S X=$O(^PS(53.1,+PSGORD,10,Q,2,X)) Q:'X D
...S PSJL=PSJL_$G(^PS(53.1,+PSGORD,10,Q,2,X,0)) D SETTMP S PSJL=" "
ACTFLG ;
S ND4=$S(PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:$G(^PS(55,PSGP,5,+PSGORD,4)))
S AT="",Y="12,13,D,18,19,H1,22,23,H0,15,16,R" F X=1:3:12 I $P(ND4,"^",$P(Y,",",X)),$P(ND4,"^",$P(Y,",",X+1)) S AT=$P(Y,",",X+2) Q
I AT="",'$P(ND4,"^",$S($P(PSJSYSU,";",3)>1:3,1:1)) S AT="V"_$S($P(ND4,"^",18):"H1",$P(ND4,"^",22):"H0",$P(ND4,"^",15):"R",1:"")
I AT]"" D
.S PSJL="" D SETTMP
.S PSJL="ORDER "_$S(AT["V":"NOT VERIFIED"_$S($P(AT,"V",2)="":"",1:" ("_$S(AT["H1":"ON HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE "_$S(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))
I AT'["V",AT["H1",$D(^PS(55,PSGP,5.1)) S AT=^(5.1) I $P(AT,"^",7),$P(AT,"^",10)]"" S PSJL=PSJL_" ("_$P(AT,"^",10)_")"
D SETTMP
S VALMCNT=PSJLN-1
K PSGSMN,Q,Y,Y1,Y2,PSGLRN
S VALM("TITLE")=PSGSTAT_" UNIT DOSE "_$S((PSGSTAT="PENDING")&($G(PSGPRIO)]""):"("_PSGPRIO_")",$G(PSGPRIO)="DONE":"("_PSGPRIO_")",1:"") I $D(PSJLMP2) S VALMBG=16 K PSJLMP2
TEST ;
I $G(PSGPFLG) S VALMSG="INVALID ORDERABLE ITEM"
I $G(PSGDI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"
I $G(PSGPI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
Q
DISPLAY ;
S PSJL=PSJWPL D SETTMP
;F X=1:1 S WRD=$P(PSJWPL," ",X) Q:WRD="" D
;.I $L(PSJL_" "_WRD)'<80 D SETTMP S PSJL=$P(PSJWPL,PSJL,2) S:$E(PSJL,1)=" " PSJL=$E(PSJL,2,999),PSJWPL="" Q
;.S PSJL=PSJL_$S(PSJL="":"",1:" ")_WRD
Q
;
SETTMP ;
S ^TMP("PSJUDE",$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1,PSJL=""
Q
;
HILITE(FLD) ;
N COL,LIN,WID,X
;Q:'$G(PSGOEENO)
S X="$T("_FLD_"^PSJLMUDE)",@("X="_X),X=$P(X,";;",2),LIN=+X,COL=$P(X,",",2),LAB=$P(X,",",3),X=$P(X,",",4),WID=(LAB+$L(@X))
;D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IOINORM,0)
I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13
D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
Q
;
1 ;;1,5,16,PSGPDN
2 ;;3,5,16,PSGDO
3 ;;4,58,7,PSGSDN
4 ;;5,10,11,PSGMRN
5 ;;6,59,6,PSGFDN
6 ;;7,6,15,PSGSTN
7 ;;18,5,14,PSGSMN
8 ;;8,11,12,PSGSCH
9 ;;9,8,13,PSGAT
10 ;;10,11,10,PSGPRN
11 ;;11,7,22,PSGSI
ENKILL ;
K PSGAT,PSGEB,PSGEFN,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM Q
PSJLMUDE ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175,201**;16 DEC 97;Build 2
+2 ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
+3 ;also chgs @init+23
+4 ;
+5 ; Reference to ^PS(55 is supported by DBIA# 2191
+6 ; Reference to ^PSDRUG is supported by DBIA 2192
+7 ;
INIT(PSGP,PSGORD) ;
+1 NEW D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR
KILL ^TMP("PSJUDE",$JOB)
+2 IF $GET(PSJNORD)
KILL PSGOEEF
SET PSJLN=1
+3 DO CLEAN^VALM10
+4 SET PSJL=$SELECT($DATA(PSGEFN(1)):$EXTRACT(" *",PSGEFN(1)+1)_"(1)",1:" ")
SET PSJL=$$SETSTR^VALM1("Orderable Item: "_PSGPDN_$$OINF^PSJDIN(PSGPD),PSJL,5,74)
Begin DoDot:1
+5 NEW Q,PSJDDA,PSJVD
FOR Q=0:0
SET Q=$ORDER(^PS(53.45,PSJSYSP,2,Q))
IF 'Q
QUIT
SET PSJDDA(+$GET(^(Q,0)))=""
+6 SET PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)
+7 SET PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)
+8 IF PSJVD]""
DO CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)
End DoDot:1
DO SETTMP
IF $GET(PSGOEEF(108))!($GET(PSGOEEF(101)))
DO HILITE(1)
+9 IF $GET(PSJORD)["P"
DO REQDT^PSJLIVMD(PSJORD)
+10 SET PSJL="Instructions: "_PSGOINST
DO PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)
+11 SET PSJL=$SELECT($DATA(PSGEFN(2)):$EXTRACT(" *",PSGEFN(2)+1)_"(2)",1:" ")
SET PSJL=$$SETSTR^VALM1("Dosage Ordered: "_PSGDO,PSJL,5,76)
DO SETTMP
IF $GET(PSGOEEF(109))
DO HILITE(2)
+12 IF $GET(PSGRDTX)
SET PSJDUR=$$FMTDUR^PSJLIVMD($PIECE($GET(PSGRDTX),U,2))
+13 IF $GET(PSJORD)
IF ($GET(PSJDUR)="")
SET P=$SELECT(PSJORD["U":5,PSJORD["V":"IV",PSJORD["P":"P",1:-1)
SET PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,P)
+14 SET PSJL=$$SETSTR^VALM1("Duration: "_$GET(PSJDUR),PSJL,11,25)
+15 SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_$PIECE(PSGSDN,U,2),PSJL,54,26)
IF $GET(PSGOEEF(10))
DO HILITE(3)
+16 IF $GET(PSGORD)["P"
NEW ND0,OLDO
SET ND0=@(PSGOEEWF_"0)")
IF $PIECE(ND0,"^",24)="R"
SET OLDO=$PIECE(ND0,"^",25)
IF OLDO
IF (OLDO["U")
Begin DoDot:1
+17 NEW OSTRT,OSTRTN
SET OSTRT=$GET(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)"))
SET OSTRT=$PIECE(OSTRT,"^",2)
IF 'OSTRT
QUIT
SET OSTRTN=$$ENDTC^PSGMI(+OSTRT)
+18 SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_OSTRTN,PSJL,54,26)
End DoDot:1
+19 DO SETTMP
+20 SET PSJL=$SELECT($DATA(PSGEFN(4)):$EXTRACT(" *",PSGEFN(4)+1)_"(4)",1:" ")
SET PSJL=$$SETSTR^VALM1("Med Route: "_PSGMRN,PSJL,10,35)
IF $GET(PSGOEEF(3))
DO HILITE(4)
+21 IF $GET(PSJORD)["P"
NEW PSGRNDT
SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD)
IF PSGRNDT
SET PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT)
SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
+22 IF '$GET(PSGRNDT)
IF $GET(PSGRDTX)
Begin DoDot:1
+23 IF $DATA(PSGRDTX)<10
SET PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX)
SET PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,48,32)
QUIT
+24 IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRSD"))
IF $PIECE($GET(PSGSDN),U,2)
SET PSGRSDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRSD"))
SET PSJL=$$SETSTR^VALM1("Calc Start: "_PSGRSDN,PSJL,53,32)
Begin DoDot:2
+25 IF PSGSD'=PSGRDTX(+PSJORD,"PSGRSD")
DO CNTRL^VALM10(5,53,80,IORVON,IORVOFF)
End DoDot:2
End DoDot:1
+26 ; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference
+27 IF $GET(PSJORD)["U"
NEW ND14
SET ND14=$GET(@(PSGOEEWF_"14,0)"))
IF ND14]""
SET ND14=$GET(^($PIECE(ND14,"^",3),0))
SET RNDT=$PIECE(ND14,"^")
IF RNDT
Begin DoDot:1
+28 NEW PSGRNDT
SET PSGRNDT=$$ENDTC^PSGMI(+RNDT)
SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
End DoDot:1
+29 DO SETTMP
+30 IF PSGORD]""
SET PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
+31 IF $GET(PSJBCMA)]""
SET PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
+32 SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(5)):$EXTRACT(" *",PSGEFN(5)+1)_"(5)",1:" ")_" Stop: "_$PIECE(PSGFDN,U,2),PSJL,54,26)
DO SETTMP
IF $GET(PSGOEEF(25))!($GET(PSGOEEF(34)))
DO HILITE(5)
+33 SET PSJL=$SELECT($DATA(PSGEFN(6)):$EXTRACT(" *",PSGEFN(6)+1)_"(6)",1:" ")
SET PSJL=$$SETSTR^VALM1("Schedule Type: "_PSGSTN,PSJL,6,45)
IF $GET(PSGOEEF(7))
DO HILITE(6)
+34 IF $GET(PSJORD)["P"
IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRFD"))
IF $PIECE($GET(PSGFDN),U,2)
SET PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD"))
SET PSJL=$$SETSTR^VALM1("Calc Stop: "_PSGRFDN,PSJL,54,26)
Begin DoDot:1
+35 IF PSGFD'=PSGRDTX(+PSJORD,"PSGRFD")
DO CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
End DoDot:1
+36 DO SETTMP
+37 SET PSGSMN=$PIECE("NO^YES",U,PSGSM+1)
+38 SET PSJL=$SELECT($DATA(PSGEFN(8)):$EXTRACT(" *",PSGEFN(8)+1)_"(8)",1:" ")
SET PSJL=$$SETSTR^VALM1("Schedule: "_PSGSCH_$GET(SCHMSG),PSJL,11,68)
DO SETTMP
IF $GET(PSGOEEF(26))
DO HILITE(8)
+39 SET PSJL=$SELECT($DATA(PSGEFN(9)):$EXTRACT(" *",PSGEFN(9)+1)_"(9)",1:" ")
SET PSJL=$$SETSTR^VALM1("Admin Times: "_PSGAT,PSJL,8,71)
DO SETTMP
IF $GET(PSGOEEF(39))!($GET(PSGOEEF(41)))
DO HILITE(9)
+40 SET PSJL=$SELECT($DATA(PSGEFN(10)):$EXTRACT(" *",PSGEFN(10)+1)_"(10)",1:" ")
SET PSJL=$$SETSTR^VALM1("Provider: "_PSGPRN,PSJL,11,68)
IF $GET(PSGOEEF(1))
DO HILITE(10)
DO SETTMP
+41 ;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:" ")_"Self Med: "_PSGSMN,PSJL,56,24) S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1(" (HS)",PSJL,71,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
+42 SET PSJL=$SELECT($DATA(PSGEFN(11)):$EXTRACT(" *",PSGEFN(11))_"(11)",1:" ")_" Special Instructions"_$SELECT($PIECE(PSGSI,"^",2)=1:"!: ",1:": ")_$PIECE(PSGSI,"^")
DO PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80)
+43 SET PSJL=""
DO SETTMP
IF $GET(PSGOEEF(8))
DO HILITE(11)
+44 ; E3R 16130
+45 IF $ORDER(^PS(53.45,PSJSYSP,2,1))
FOR
SET PSJL=""
DO SETTMP
IF PSJLN>15
QUIT
+46 SET PSJL=$SELECT($DATA(PSGEFN(12)):$EXTRACT(" *",PSGEFN(12))_" (12)",1:" ")_" Dispense Drug"
SET PSJL=$$SETSTR^VALM1("U/D",PSJL,54,60)
SET PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,65,16)
DO SETTMP
DO CNTRL^VALM10(13,1,80,IOUON,IOUOFF,0)
+47 ;S $P(PSJL,"-",80)="" D SETTMP
+48 NEW PSJX
+49 FOR Q=0:0
SET Q=$ORDER(^PS(53.45,PSJSYSP,2,Q))
IF 'Q
QUIT
SET ND=$GET(^(Q,0))
Begin DoDot:1
+50 SET D=$PIECE(ND,"^")
SET PSGID=$PIECE(ND,"^",3)
IF PSGID
SET PSGID=$$ENDTC^PSGMI(PSGID)
+51 SET D=$SELECT(D="":"NOT FOUND",'$DATA(^PSDRUG(D,0)):D,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:D_";PSDRUG(")
+52 SET PSJL=" "_D_$$DDNF^PSJDIN(+ND)
SET PSJL=$$SETSTR^VALM1($SELECT($PIECE(ND,"^",2):$SELECT($PIECE(ND,"^",2)=.5:"1/2",$PIECE(ND,"^",2)=.25:"1/4",1:$PIECE(ND,"^",2)),$PIECE(ND,"^",2)=0:0,1:1),PSJL,54,63)
IF PSGID
SET PSJL=$$SETSTR^VALM1(PSGID,PSJL,65,16)
Begin DoDot:2
+53 SET PSJX=$GET(PSJX)+1
+54 IF $GET(PSGOEEF(109))
DO CNTRL^VALM10(13+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)
End DoDot:2
DO SETTMP
End DoDot:1
+55 IF $SELECT(PSGORD["P":$ORDER(^PS(53.1,+$GET(PSGORD),12,0)),1:$ORDER(^PS(55,PSGP,5,+PSGORD,12,0)))
SET PSJL="Provider Comments:"
DO SETTMP
SET PSJL=""
Begin DoDot:1
+56 FOR Q=0:0
SET Q=$SELECT(PSGORD["P":$ORDER(^PS(53.1,+$GET(PSGORD),12,Q)),1:$ORDER(^PS(55,PSGP,5,+PSGORD,12,Q)))
IF 'Q
QUIT
SET PSJL=$GET(^(Q,0))
DO SETTMP
End DoDot:1
+57 DO SETTMP
SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(7)):$EXTRACT(" *",PSGEFN(7)+1)_"(7)",1:" ")_"Self Med: "_PSGSMN,PSJL,1,24)
+58 IF PSGSM&PSGHSM
SET PSJL=$$SETSTR^VALM1(" (HS)",PSJL,16,7)
DO SETTMP
IF $GET(PSGOEEF(5))
DO HILITE(7)
+59 DO SETTMP
SET PSJL="Entry By: "_PSGEBN
SET PSJL=$$SETSTR^VALM1("Entry Date: "_$PIECE(PSGLIN,U,2),PSJL,51,39)
DO SETTMP
+60 IF $GET(PSGLRN)
DO SETTMP
SET PSJL="Renewed By: "_$$ENNPN^PSGMI($PIECE(PSGLRN,"^",2))
DO SETTMP
+61 DO SETTMP
SET PSJL="(13)"_" Comments:"
+62 IF '$ORDER(^PS(53.45,PSJSYSP,1,0))
DO SETTMP
+63 DO SETTMP
FOR Q=0:0
SET Q=$ORDER(^PS(53.45,PSJSYSP,1,Q))
IF 'Q
QUIT
SET PSJWPL=PSJL_$SELECT($EXTRACT(PSJL)=" ":"",1:" ")_$GET(^(Q,0))
SET PSJL=""
DO DISPLAY
+64 DO SETTMP
+65 IF PSGORD["P"
IF ($PIECE($GET(^PS(53.1,+PSGORD,0)),U,9)="P")
IF $ORDER(^PS(53.1,+PSGORD,10,0))
Begin DoDot:1
+66 DO SETTMP
SET PSJL="Order Checks:"
DO SETTMP
+67 FOR Q=0:0
SET Q=$ORDER(^PS(53.1,+PSGORD,10,Q))
IF 'Q
QUIT
Begin DoDot:2
+68 SET PSJL=""
DO SETTMP
SET PSJL=$GET(^PS(53.1,+PSGORD,10,Q,0))
DO SETTMP
+69 SET PSJL="Overriding Provider: "_$PIECE($GET(^PS(53.1,+PSGORD,10,Q,1)),U)
DO SETTMP
+70 SET PSJL="Overriding Reason: "
FOR X=0:0
SET X=$ORDER(^PS(53.1,+PSGORD,10,Q,2,X))
IF 'X
QUIT
Begin DoDot:3
+71 SET PSJL=PSJL_$GET(^PS(53.1,+PSGORD,10,Q,2,X,0))
DO SETTMP
SET PSJL=" "
End DoDot:3
End DoDot:2
End DoDot:1
ACTFLG ;
+1 SET ND4=$SELECT(PSGORD["P":$GET(^PS(53.1,+PSGORD,4)),1:$GET(^PS(55,PSGP,5,+PSGORD,4)))
+2 SET AT=""
SET Y="12,13,D,18,19,H1,22,23,H0,15,16,R"
FOR X=1:3:12
IF $PIECE(ND4,"^",$PIECE(Y,",",X))
IF $PIECE(ND4,"^",$PIECE(Y,",",X+1))
SET AT=$PIECE(Y,",",X+2)
QUIT
+3 IF AT=""
IF '$PIECE(ND4,"^",$SELECT($PIECE(PSJSYSU,";",3)>1:3,1:1))
SET AT="V"_$SELECT($PIECE(ND4,"^",18):"H1",$PIECE(ND4,"^",22):"H0",$PIECE(ND4,"^",15):"R",1:"")
+4 IF AT]""
Begin DoDot:1
+5 SET PSJL=""
DO SETTMP
+6 SET PSJL="ORDER "_$SELECT(AT["V":"NOT VERIFIED"_$SELECT($PIECE(AT,"V",2)="":"",1:" ("_...
... $SELECT(AT["H1":"ON HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE "_$SELECT(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))
End DoDot:1
+7 IF AT'["V"
IF AT["H1"
IF $DATA(^PS(55,PSGP,5.1))
SET AT=^(5.1)
IF $PIECE(AT,"^",7)
IF $PIECE(AT,"^",10)]""
SET PSJL=PSJL_" ("_$PIECE(AT,"^",10)_")"
+8 DO SETTMP
+9 SET VALMCNT=PSJLN-1
+10 KILL PSGSMN,Q,Y,Y1,Y2,PSGLRN
+11 SET VALM("TITLE")=PSGSTAT_" UNIT DOSE "_$SELECT((PSGSTAT="PENDING")&($GET(PSGPRIO)]""):"("_PSGPRIO_")",$GET(PSGPRIO)="DONE":"("_PSGPRIO_")",1:"")
IF $DATA(PSJLMP2)
SET VALMBG=16
KILL PSJLMP2
TEST ;
+1 IF $GET(PSGPFLG)
SET VALMSG="INVALID ORDERABLE ITEM"
+2 IF $GET(PSGDI)
SET VALMSG=$SELECT($GET(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"
+3 IF $GET(PSGPI)
SET VALMSG=$SELECT($GET(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
+4 QUIT
DISPLAY ;
+1 SET PSJL=PSJWPL
DO SETTMP
+2 ;F X=1:1 S WRD=$P(PSJWPL," ",X) Q:WRD="" D
+3 ;.I $L(PSJL_" "_WRD)'<80 D SETTMP S PSJL=$P(PSJWPL,PSJL,2) S:$E(PSJL,1)=" " PSJL=$E(PSJL,2,999),PSJWPL="" Q
+4 ;.S PSJL=PSJL_$S(PSJL="":"",1:" ")_WRD
+5 QUIT
+6 ;
SETTMP ;
+1 SET ^TMP("PSJUDE",$JOB,PSJLN,0)=PSJL
SET PSJLN=PSJLN+1
SET PSJL=""
+2 QUIT
+3 ;
HILITE(FLD) ;
+1 NEW COL,LIN,WID,X
+2 ;Q:'$G(PSGOEENO)
+3 SET X="$T("_FLD_"^PSJLMUDE)"
SET @("X="_X)
SET X=$PIECE(X,";;",2)
SET LIN=+X
SET COL=$PIECE(X,",",2)
SET LAB=$PIECE(X,",",3)
SET X=$PIECE(X,",",4)
SET WID=(LAB+$LENGTH(@X))
+4 ;D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IOINORM,0)
+5 IF FLD=7
SET LIN=+$GET(PSJLN)-1
IF LIN<13
QUIT
+6 DO CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
+7 QUIT
+8 ;
1 ;;1,5,16,PSGPDN
2 ;;3,5,16,PSGDO
3 ;;4,58,7,PSGSDN
4 ;;5,10,11,PSGMRN
5 ;;6,59,6,PSGFDN
6 ;;7,6,15,PSGSTN
7 ;;18,5,14,PSGSMN
8 ;;8,11,12,PSGSCH
9 ;;9,8,13,PSGAT
10 ;;10,11,10,PSGPRN
11 ;;11,7,22,PSGSI
ENKILL ;
+1 KILL PSGAT,PSGEB,PSGEFN,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM
QUIT
