- PSIVOE ;BIR/PR,MLM-OE/RR UTILITY FOR IV ORDERS ;21 AUG 97 / 4:04 PM
- ;;5.0; INPATIENT MEDICATIONS ;**51**;16 DEC 97
- ;
- ; 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)
- 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
- PSIVOE ;BIR/PR,MLM-OE/RR UTILITY FOR IV ORDERS ;21 AUG 97 / 4:04 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**51**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191.
- +4 ; Reference to ^PS(52.6 is supported by DBIA 1231.
- +5 ; Reference to ^PS(52.7 is supported by DBIA 2173.
- +6 ;
- 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 DO KL
- +5 QUIT
- +6 ;
- 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