PSJLIORD ;BIR/MV-INPATIENT ORDER ENTRY FOR IV ;10 Mar 98 / 4:19 PM
;;5.0; INPATIENT MEDICATIONS ;**1,16,29,58,85,110,149**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA #2191.
; Reference to EN1^ORCFLAG is supported by DBIA #3620.
; Reference to AND^ORX8 is supported by DBIA #3632.
;
EN(DFN,PSJORD) ; Display order with numbers.
;N ON,ON55,P,PSIVAC,PSGEBN,PSGLI,PSJSTAR
N ON55,P,PSIVAC,PSGEBN,PSGLI,PSJSTAR
D UDVARS
S (PSGEBN,PSGLI)=""
;* S PSIVAC="C" S (P("PON"),ON,ON55)=+PSJORD_"V"
S PSIVAC="E" S (P("PON"),ON,ON55)=+PSJORD_"V"
S PSIVUP=+$$GTPCI^PSIVUTL D GT55^PSIVORFB
D:'$D(P("OT")) GTOT^PSIVUTL(P(4))
NEW PSJL
N PSIVNUM S PSIVNUM=1
;;I $E(P("OT"))'="F" S PSJSTAR="(1)^(4)^(5)^(6)^(7)^(9)^(10)"
I $E(P("OT"))="I" S PSJSTAR="(1)^(4)^(5)^(6)^(7)^(9)^(10)"
E S PSJSTAR="(1)^(2)^(3)^(4)^(5)^(6)^(7)^(9)" D GTDATA^PSJLIFN
NEW PSGACT D PSGACT
;* Only allow activity logs for non pharmacist/RN personel if coming
;* from the Non-verify/pending option.
I '+$P(PSJSYSU,";"),$G(PSJPNV) S PSGACT="L"
D EN^VALM("PSJ LM IV INPT ACTIVE") ; Call to EN^PSJLIVMD
S VALMBCK="Q"
Q
;
PSGACT ;Setup selectable actions based on order's status
S (X,XKEYS)=$$CHKKEYS()
N PSGR S PSGACT=""
S PSJCOM=$P($G(^PS(55,DFN,"IV",+ON55,.2)),U,8)
I PSJCOM S PSGR=0
I PSJCOM S PSGR=$$AND^ORX8(PSJCOM) S:PSGR=1 PSGR=$$RNEWOK^PSJUTL2(PSJCOM,DFN)
I 'PSJCOM S PSGR='$$EXPIRED^PSGOER(DFN,ON55)
S X=XKEYS
;I P(17)="A" S PSGACT=$S(PSJCOM:"L",1:"EL") S:+X PSGACT=PSGACT_"DO"_$S(P(10):"",1:"H")_$S(PSGR:"R",1:"")
;I P(17)="A" S PSGACT="L" S:+X PSGACT=$S(P(10):"DROL",1:"DHROL")
I P(17)="A" S PSGACT="EL" S:+X PSGACT=PSGACT_"DO"_$S(P(10):"",1:"H")_$S(PSGR:"R",1:"")
I P(17)="H" S PSGACT="L" S:+X PSGACT=$S(P(10):"DL",1:"DHL")
I P(17)="R" S PSGACT="L" ;S:+X PSGACT="DL" PSJ*5*149
I P(17)="D" S PSGACT="L"
I P(17)="D"&P(12) S PSGACT="L" S:+X PSGACT="L"_$S(PSGR:"R",1:"")
I P(17)="E" S PSGACT="L" D:+X
. I $P($G(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D" Q
. S PSGACT="L"_$S($P($G(^PS(55,DFN,"IV",+ON55,2)),U,6):"",PSGR:"R",1:"")
I P(17)="O" S PSGACT="L" S:+X PSGACT="DOL"
I P(17)="N" S PSGACT="EL" S:+X PSGACT="DELV"
S PSGACT=PSGACT_$P(X,U,2)
Q
UDVARS ;* Remove un-use variables.
K PSGCANFL,PSGDI,PSGDO,PSGEB,PSGEBN,PSGFD,PSGFDN,PSHSM,PSGLI
K PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEF,PSGOAT
K PSGODO,PSGODT,PSGOEA,PSGOEAV,PSGOEEWF,PSGOENG,PSGOFD,PSGOFDN
K PSGOHSM,PSGOINST,PSGOMR,PSGOMRN,PSGONC,PSGOPD,PSGOPDN,PSGOPR
K PSGOPRN,PSGOSCH,PSGOSD,PSGOSDN,PSGOSI,PSGOSM,PSGOST,PSGOSTN
K PSGPD,PSGPDN,PSGPI,PSGPR,PSGPRIO,PSGPRN,PSGPTMP,PSGRRF,PSGS0XT
K PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM,PSGST,PSGSTAT,PSGSTN
K PSGEFN,PSGOEFN,PSGOEEF,PSGOEEG,PSGOEEND,PSGPDRG,PSGPDRGN
K PSGNESDO,PSGNODE,PSGOEDMR,PSGOEPR,PSGPEN,PSGPENWS
Q
CHKKEYS() ;* Check for users' key to set up appropriate actions
;Output:
; X=a^b
; a=1 for either RN or Pharmacist; 0 for other
; b="V" if not verified by key owner
S XX=$G(^PS(55,DFN,"IV",+ON,4)),X=0
I +PSJSYSU=3 S X=1 D
. I '+$P(XX,U,4) S $P(X,U,2)="V"
. I $L($T(EN1^ORCFLAG)) S $P(X,U,2)=$P(X,U,2)_"G"
I +PSJSYSU=1 S X=1 D
. I '+XX S $P(X,U,2)="V"
Q X
PSJLIORD ;BIR/MV-INPATIENT ORDER ENTRY FOR IV ;10 Mar 98 / 4:19 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**1,16,29,58,85,110,149**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA #2191.
+4 ; Reference to EN1^ORCFLAG is supported by DBIA #3620.
+5 ; Reference to AND^ORX8 is supported by DBIA #3632.
+6 ;
EN(DFN,PSJORD) ; Display order with numbers.
+1 ;N ON,ON55,P,PSIVAC,PSGEBN,PSGLI,PSJSTAR
+2 NEW ON55,P,PSIVAC,PSGEBN,PSGLI,PSJSTAR
+3 DO UDVARS
+4 SET (PSGEBN,PSGLI)=""
+5 ;* S PSIVAC="C" S (P("PON"),ON,ON55)=+PSJORD_"V"
+6 SET PSIVAC="E"
SET (P("PON"),ON,ON55)=+PSJORD_"V"
+7 SET PSIVUP=+$$GTPCI^PSIVUTL
DO GT55^PSIVORFB
+8 IF '$DATA(P("OT"))
DO GTOT^PSIVUTL(P(4))
+9 NEW PSJL
+10 NEW PSIVNUM
SET PSIVNUM=1
+11 ;;I $E(P("OT"))'="F" S PSJSTAR="(1)^(4)^(5)^(6)^(7)^(9)^(10)"
+12 IF $EXTRACT(P("OT"))="I"
SET PSJSTAR="(1)^(4)^(5)^(6)^(7)^(9)^(10)"
+13 IF '$TEST
SET PSJSTAR="(1)^(2)^(3)^(4)^(5)^(6)^(7)^(9)"
DO GTDATA^PSJLIFN
+14 NEW PSGACT
DO PSGACT
+15 ;* Only allow activity logs for non pharmacist/RN personel if coming
+16 ;* from the Non-verify/pending option.
+17 IF '+$PIECE(PSJSYSU,";")
IF $GET(PSJPNV)
SET PSGACT="L"
+18 ; Call to EN^PSJLIVMD
DO EN^VALM("PSJ LM IV INPT ACTIVE")
+19 SET VALMBCK="Q"
+20 QUIT
+21 ;
PSGACT ;Setup selectable actions based on order's status
+1 SET (X,XKEYS)=$$CHKKEYS()
+2 NEW PSGR
SET PSGACT=""
+3 SET PSJCOM=$PIECE($GET(^PS(55,DFN,"IV",+ON55,.2)),U,8)
+4 IF PSJCOM
SET PSGR=0
+5 IF PSJCOM
SET PSGR=$$AND^ORX8(PSJCOM)
IF PSGR=1
SET PSGR=$$RNEWOK^PSJUTL2(PSJCOM,DFN)
+6 IF 'PSJCOM
SET PSGR='$$EXPIRED^PSGOER(DFN,ON55)
+7 SET X=XKEYS
+8 ;I P(17)="A" S PSGACT=$S(PSJCOM:"L",1:"EL") S:+X PSGACT=PSGACT_"DO"_$S(P(10):"",1:"H")_$S(PSGR:"R",1:"")
+9 ;I P(17)="A" S PSGACT="L" S:+X PSGACT=$S(P(10):"DROL",1:"DHROL")
+10 IF P(17)="A"
SET PSGACT="EL"
IF +X
SET PSGACT=PSGACT_"DO"_$SELECT(P(10):"",1:"H")_$SELECT(PSGR:"R",1:"")
+11 IF P(17)="H"
SET PSGACT="L"
IF +X
SET PSGACT=$SELECT(P(10):"DL",1:"DHL")
+12 ;S:+X PSGACT="DL" PSJ*5*149
IF P(17)="R"
SET PSGACT="L"
+13 IF P(17)="D"
SET PSGACT="L"
+14 IF P(17)="D"&P(12)
SET PSGACT="L"
IF +X
SET PSGACT="L"_$SELECT(PSGR:"R",1:"")
+15 IF P(17)="E"
SET PSGACT="L"
IF +X
Begin DoDot:1
+16 IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D"
QUIT
+17 SET PSGACT="L"_$SELECT($PIECE($GET(^PS(55,DFN,"IV",+ON55,2)),U,6):"",PSGR:"R",1:"")
End DoDot:1
+18 IF P(17)="O"
SET PSGACT="L"
IF +X
SET PSGACT="DOL"
+19 IF P(17)="N"
SET PSGACT="EL"
IF +X
SET PSGACT="DELV"
+20 SET PSGACT=PSGACT_$PIECE(X,U,2)
+21 QUIT
UDVARS ;* Remove un-use variables.
+1 KILL PSGCANFL,PSGDI,PSGDO,PSGEB,PSGEBN,PSGFD,PSGFDN,PSHSM,PSGLI
+2 KILL PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEF,PSGOAT
+3 KILL PSGODO,PSGODT,PSGOEA,PSGOEAV,PSGOEEWF,PSGOENG,PSGOFD,PSGOFDN
+4 KILL PSGOHSM,PSGOINST,PSGOMR,PSGOMRN,PSGONC,PSGOPD,PSGOPDN,PSGOPR
+5 KILL PSGOPRN,PSGOSCH,PSGOSD,PSGOSDN,PSGOSI,PSGOSM,PSGOST,PSGOSTN
+6 KILL PSGPD,PSGPDN,PSGPI,PSGPR,PSGPRIO,PSGPRN,PSGPTMP,PSGRRF,PSGS0XT
+7 KILL PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM,PSGST,PSGSTAT,PSGSTN
+8 KILL PSGEFN,PSGOEFN,PSGOEEF,PSGOEEG,PSGOEEND,PSGPDRG,PSGPDRGN
+9 KILL PSGNESDO,PSGNODE,PSGOEDMR,PSGOEPR,PSGPEN,PSGPENWS
+10 QUIT
CHKKEYS() ;* Check for users' key to set up appropriate actions
+1 ;Output:
+2 ; X=a^b
+3 ; a=1 for either RN or Pharmacist; 0 for other
+4 ; b="V" if not verified by key owner
+5 SET XX=$GET(^PS(55,DFN,"IV",+ON,4))
SET X=0
+6 IF +PSJSYSU=3
SET X=1
Begin DoDot:1
+7 IF '+$PIECE(XX,U,4)
SET $PIECE(X,U,2)="V"
+8 IF $LENGTH($TEXT(EN1^ORCFLAG))
SET $PIECE(X,U,2)=$PIECE(X,U,2)_"G"
End DoDot:1
+9 IF +PSJSYSU=1
SET X=1
Begin DoDot:1
+10 IF '+XX
SET $PIECE(X,U,2)="V"
End DoDot:1
+11 QUIT X
