PSIVOE ;BIR/PR,MLM-OE/RR UTILITY FOR IV ORDERS ;21 AUG 97 / 4:04 PM
;;5.0;INPATIENT MEDICATIONS;**51,426**;16 DEC 97;Build 4
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^PS(52.6 is supported by DBIA 1231.
; Reference to ^PS(52.7 is supported by DBIA 2173.
;
ND ;
S N=$G(^PS(55,DFN,"IV",+ON,0)),P17=$P(N,U,17),ORIFN=$P(N,U,21) D:'$D(PSJIVORF) ORPARM^PSIVOREN I 'PSJIVORF S ORIFN="" Q
Q
;
HOLD ; Update status of hold orders.
D ND
NEW PROC,PROCX S PROC=$S(P17="A":"OE",1:"OH") S PROCX=$S(P17="A":"ORDER OFF HOLD",1:"ORDER ON HOLD")
D EN1^PSJHL2(DFN,PROC,+ON_"V",PROCX)
;Removes Nurse Verification
D DELNV^PSJUTL3(DFN,+ON_"V")
D KL
Q
;
DCNV ;Delete order from 100.
D ND
I +$P(N,U,21),(P17'="P") D EN1^PSJHL2(DFN,"Z@",+ON_"V","PHARMACY ORDER PURGED")
D KL
Q
;
AUTO ;Auto DC orders. Called from PSJAC0
D ND I ORIFN D EN1^PSJHL2(DFN,"OD",+ON_"V","ORDER DISCONTINUED")
D KL
Q
;
EXPIR ;Expire orders called from PSIVACT.
D ND I ORIFN D EN1^PSJHL2(DFN,"SC",+ON_"V","ORDER EXPIRED")
D KL
Q
;
PSIVTX ; Set ORTX for profiles.
D ND S SCHED=$P(N,U,9)
I $G(^PS(55,DFN,"IV",+ON,6)) S PDND=^(6),ORTX=$$ENPDN^PSGMI(+PDND)_"|Give: "_$P(PDND,U,2)_" "_$$ENMRN^PSGMI($P(PDND,U,3))_" "_$S(SCHED]"":SCHED,1:$P(N,U,8)) D KTX Q
S C=0 F I=0:0 S I=$O(^PS(55,DFN,"IV",ON,"AD",I)) Q:'I I $D(^(I,0)) S C=C+1 S:C>1 DOT="..." S:C'>1 ADD=^(0)
S C=0 F I=0:0 S I=$O(^PS(55,DFN,"IV",ON,"SOL",I)) Q:'I I $D(^(I,0)) S C=C+1 S:C>1 DOT2="..." S:C'>1 SOL=$P(^(0),U)
S:$D(ADD) ADD=$S($D(^PS(52.6,+ADD,0)):$P(^(0),U),1:"")_$S($P(ADD,"^",2):" "_$P(ADD,"^",2),1:"") S:$D(SOL) SOL=$S($D(^PS(52.7,SOL,0)):$P(^(0),U),1:"")
S:$D(DOT)&($D(ADD)) ADD=ADD_DOT S:$D(DOT2)&($D(SOL)) SOL=SOL_DOT2 S ORTX=$S($D(ADD):ADD,1:"*NF*")_"| in "_$S($D(SOL):SOL,1:"*NF*")_"|"_SCHED
KTX K DOT,DOT2,C,ADD,SOL,I,SCHED,N,PDND
;
KL K N,P17
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVOE 1875 printed Dec 13, 2024@02:04:28 Page 2
PSIVOE ;BIR/PR,MLM-OE/RR UTILITY FOR IV ORDERS ;21 AUG 97 / 4:04 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**51,426**;16 DEC 97;Build 4
+2 ; Reference to ^PS(55 is supported by DBIA 2191.
+3 ; Reference to ^PS(52.6 is supported by DBIA 1231.
+4 ; Reference to ^PS(52.7 is supported by DBIA 2173.
+5 ;
ND ;
+1 SET N=$GET(^PS(55,DFN,"IV",+ON,0))
SET P17=$PIECE(N,U,17)
SET ORIFN=$PIECE(N,U,21)
if '$DATA(PSJIVORF)
DO ORPARM^PSIVOREN
IF 'PSJIVORF
SET ORIFN=""
QUIT
+2 QUIT
+3 ;
HOLD ; Update status of hold orders.
+1 DO ND
+2 NEW PROC,PROCX
SET PROC=$SELECT(P17="A":"OE",1:"OH")
SET PROCX=$SELECT(P17="A":"ORDER OFF HOLD",1:"ORDER ON HOLD")
+3 DO EN1^PSJHL2(DFN,PROC,+ON_"V",PROCX)
+4 ;Removes Nurse Verification
+5 DO DELNV^PSJUTL3(DFN,+ON_"V")
+6 DO KL
+7 QUIT
+8 ;
DCNV ;Delete order from 100.
+1 DO ND
+2 IF +$PIECE(N,U,21)
IF (P17'="P")
DO EN1^PSJHL2(DFN,"Z@",+ON_"V","PHARMACY ORDER PURGED")
+3 DO KL
+4 QUIT
+5 ;
AUTO ;Auto DC orders. Called from PSJAC0
+1 DO ND
IF ORIFN
DO EN1^PSJHL2(DFN,"OD",+ON_"V","ORDER DISCONTINUED")
+2 DO KL
+3 QUIT
+4 ;
EXPIR ;Expire orders called from PSIVACT.
+1 DO ND
IF ORIFN
DO EN1^PSJHL2(DFN,"SC",+ON_"V","ORDER EXPIRED")
+2 DO KL
+3 QUIT
+4 ;
PSIVTX ; Set ORTX for profiles.
+1 DO ND
SET SCHED=$PIECE(N,U,9)
+2 IF $GET(^PS(55,DFN,"IV",+ON,6))
SET PDND=^(6)
SET ORTX=$$ENPDN^PSGMI(+PDND)_"|Give: "_$PIECE(PDND,U,2)_" "_$$ENMRN^PSGMI($PIECE(PDND,U,3))_" "_$SELECT(SCHED]"":SCHED,1:$PIECE(N,U,8))
DO KTX
QUIT
+3 SET C=0
FOR I=0:0
SET I=$ORDER(^PS(55,DFN,"IV",ON,"AD",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET C=C+1
if C>1
SET DOT="..."
if C'>1
SET ADD=^(0)
+4 SET C=0
FOR I=0:0
SET I=$ORDER(^PS(55,DFN,"IV",ON,"SOL",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET C=C+1
if C>1
SET DOT2="..."
if C'>1
SET SOL=$PIECE(^(0),U)
+5 if $DATA(ADD)
SET ADD=$SELECT($DATA(^PS(52.6,+ADD,0)):$PIECE(^(0),U),1:"")_$SELECT($PIECE(ADD,"^",2):" "_$PIECE(ADD,"^",2),1:"")
if $DATA(SOL)
SET SOL=$SELECT($DATA(^PS(52.7,SOL,0)):$PIECE(^(0),U),1:"")
+6 if $DATA(DOT)&($DATA(ADD))
SET ADD=ADD_DOT
if $DATA(DOT2)&($DATA(SOL))
SET SOL=SOL_DOT2
SET ORTX=$SELECT($DATA(ADD):ADD,1:"*NF*")_"| in "_$SELECT($DATA(SOL):SOL,1:"*NF*")_"|"_SCHED
KTX KILL DOT,DOT2,C,ADD,SOL,I,SCHED,N,PDND
+1 ;
KL KILL N,P17
+1 QUIT