PSIVSPDC ;BIR/PR,MV-SPEED DC IV ORDERS ;02 Mar 99 / 9:27 AM
;;5.0; INPATIENT MEDICATIONS ;**23,29,38,58,110**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA# 2191.
; Reference to ^PSSLOCK is supported by DBIA #2789
;
EN ;Loop thru to find IV ien to DC
I $S(+PSJSYSU=3:0,+PSJSYSU=1:0,1:1) D Q
. W !,"You're not allowed to DC orders." D PAUSE^VALM1
NEW ON,ON55,PSIVX,SORT,NAT,PSIVAL,PSJORD,PSGODDD,DIR
S PSGLMT=$O(^TMP("PSIV",$J,"XB",0))-1
S:PSGLMT<1 PSGLMT=$G(^TMP("PSJPRO",$J,0))
Q:'+PSGLMT
S DIR("?")="Enter the order number(s) to be Discontinued"
S DIR(0)="L^1:"_PSGLMT,DIR("A")="DISCONTINUE which orders" D ^DIR
S PSGODDD=Y Q:$D(DIRUT)
;prompt for nature of order and requesting provider
D NATURE^PSIVOREN I '$D(P("NAT"))!'$$REQPROV^PSGOEC W !,$C(7),"No order(s) was DC." H 2 Q
S NAT=P("NAT") D COMMENT
N COMFLG,PSJCOM S PSJCOM=0
S SORT="" F S SORT=$O(^TMP("PSIV",$J,SORT)) Q:SORT="" F PSIVX=0:0 S PSIVX=$O(^TMP("PSIV",$J,SORT,PSIVX)) Q:'PSIVX I PSGODDD[PSIVX S ON=^(PSIVX),ON=(9999999999-ON)_$E(ON,11,11) D
. D CHKCOM I COMFLG D PRNT Q
. D:'PSJCOM SPDCIV
Q
SPDCIV ;Speed DC orders
S (PSJORD,ON55)=ON
I ON["V",$P($G(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D" W !," ***** DONE ORDER *****" D PRNT Q
I '$$LS^PSSLOCK(DFN,ON) D PRNT Q
I ON["V" D Q
. S P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3)
. D NOW^%DTC Q:P(3)<%
. D D1^PSIVOPT2
. S PSIVALT=1,PSIVALCK="STOP",PSIVREA="D",ON=ON55 D LOG
. S:'$D(P("NAT")) P("NAT")=$G(PSJNOO) D HL^PSIVORA
. D UNL^PSSLOCK(DFN,ON)
.;;I $D(PSJNOO) S P("NAT")=PSJNOO D EN1^PSJHL2(DFN,"OC",PSJORD,"ORDER CANCELED")
N DA,DR,DIE,PSJND S DA=+PSJORD,PSJND=$G(^PS(53.1,DA,0)),P("OLDON")=$P(PSJND,U,25),DIE="^PS(53.1,",DR="28///"_$S($P(PSJND,U,27)="E":"DE",1:"D") D ^DIE
D HL^PSIVORA
D UNL^PSSLOCK(DFN,ON)
Q
I $G(PSIVALT)=1,'$G(PSJUNDC) K DA,DIR S DIR(0)="55.04,.04" D ^DIR K DA,DIR S PSIVAL=$S($D(DIRUT):"",1:Y)
Q
LOG ;Record activity log comments.
S:$G(PSIVALT)=2 PSIVAL="Action taken using OE/RR options." D ENTACT^PSIVAL
K DA,DIE,DR S DA(2)=DFN,DA(1)=+ON55,DA=PSIVLN,DIE="^PS(55,"_DFN_",""IV"","_+ON55_",""A"",",DR=".02////"_PSIVREA_";.03////"_$P(^VA(200,DUZ,0),U)_";.04////^S X=$G(PSIVAL)"_";.06////"_DUZ D ^DIE
D STOP^PSIVORAL ;* Record the stop dates
Q
PRNT ; DISPLAY IV ORDER AND PRINT MESSAGE
N PSJLINE,PSJOC S PSJLINE=1
D DSPLORDV^PSJLMUT1(DFN,ON)
F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
.W !,$G(PSJOC(ON,X))
W !," ***** NO ACTION TAKEN ON ORDER *****",!
Q
CHKCOM ;Check to see if order is part of complex order series.
N PSJSTAT
S PSJCOM=$P($G(^PS(55,PSGP,"IV",+ON,.2)),U,8),COMFLG=0,PSJSTAT=$P($G(^(0)),"^",17)
Q:'PSJCOM I "DE"[PSJSTAT Q
N PSJLINE,PSJOC S PSJLINE=1
D DSPLORDV^PSJLMUT1(DFN,ON)
W ! F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
.W !,$G(PSJOC(ON,X))
W !,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)." D CMPLX^PSJCOM1(DFN,PSJCOM,ON)
F W !!,"Do you want to discontinue this series of complex orders" S %=1 D YN^DICN Q:%
I %'=1 S COMFLG=1 Q
N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" D Q:COMFLG
.Q:OO=ON I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
Q:COMFLG
N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" D
.I (OO["U") N PSGORD S PSGORD=OO D AC^PSGOECS
.I (OO["V") N PSGORD S (ON,PSGORD)=OO D SPDCIV^PSIVSPDC
.D UNL^PSSLOCK(DFN,PSGORD)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVSPDC 3621 printed Dec 13, 2024@02:05:05 Page 2
PSIVSPDC ;BIR/PR,MV-SPEED DC IV ORDERS ;02 Mar 99 / 9:27 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**23,29,38,58,110**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191.
+4 ; Reference to ^PSSLOCK is supported by DBIA #2789
+5 ;
EN ;Loop thru to find IV ien to DC
+1 IF $SELECT(+PSJSYSU=3:0,+PSJSYSU=1:0,1:1)
Begin DoDot:1
+2 WRITE !,"You're not allowed to DC orders."
DO PAUSE^VALM1
End DoDot:1
QUIT
+3 NEW ON,ON55,PSIVX,SORT,NAT,PSIVAL,PSJORD,PSGODDD,DIR
+4 SET PSGLMT=$ORDER(^TMP("PSIV",$JOB,"XB",0))-1
+5 if PSGLMT<1
SET PSGLMT=$GET(^TMP("PSJPRO",$JOB,0))
+6 if '+PSGLMT
QUIT
+7 SET DIR("?")="Enter the order number(s) to be Discontinued"
+8 SET DIR(0)="L^1:"_PSGLMT
SET DIR("A")="DISCONTINUE which orders"
DO ^DIR
+9 SET PSGODDD=Y
if $DATA(DIRUT)
QUIT
+10 ;prompt for nature of order and requesting provider
+11 DO NATURE^PSIVOREN
IF '$DATA(P("NAT"))!'$$REQPROV^PSGOEC
WRITE !,$CHAR(7),"No order(s) was DC."
HANG 2
QUIT
+12 SET NAT=P("NAT")
DO COMMENT
+13 NEW COMFLG,PSJCOM
SET PSJCOM=0
+14 SET SORT=""
FOR
SET SORT=$ORDER(^TMP("PSIV",$JOB,SORT))
if SORT=""
QUIT
FOR PSIVX=0:0
SET PSIVX=$ORDER(^TMP("PSIV",$JOB,SORT,PSIVX))
if 'PSIVX
QUIT
IF PSGODDD[PSIVX
SET ON=^(PSIVX)
SET ON=(9999999999-ON)_$EXTRACT(ON,11,11)
Begin DoDot:1
+15 DO CHKCOM
IF COMFLG
DO PRNT
QUIT
+16 if 'PSJCOM
DO SPDCIV
End DoDot:1
+17 QUIT
SPDCIV ;Speed DC orders
+1 SET (PSJORD,ON55)=ON
+2 IF ON["V"
IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D"
WRITE !," ***** DONE ORDER *****"
DO PRNT
QUIT
+3 IF '$$LS^PSSLOCK(DFN,ON)
DO PRNT
QUIT
+4 IF ON["V"
Begin DoDot:1
+5 SET P(3)=$PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),U,3)
+6 DO NOW^%DTC
if P(3)<%
QUIT
+7 DO D1^PSIVOPT2
+8 SET PSIVALT=1
SET PSIVALCK="STOP"
SET PSIVREA="D"
SET ON=ON55
DO LOG
+9 if '$DATA(P("NAT"))
SET P("NAT")=$GET(PSJNOO)
DO HL^PSIVORA
+10 DO UNL^PSSLOCK(DFN,ON)
+11 ;;I $D(PSJNOO) S P("NAT")=PSJNOO D EN1^PSJHL2(DFN,"OC",PSJORD,"ORDER CANCELED")
End DoDot:1
QUIT
+12 NEW DA,DR,DIE,PSJND
SET DA=+PSJORD
SET PSJND=$GET(^PS(53.1,DA,0))
SET P("OLDON")=$PIECE(PSJND,U,25)
SET DIE="^PS(53.1,"
SET DR="28///"_$SELECT($PIECE(PSJND,U,27)="E":"DE",1:"D")
DO ^DIE
+13 DO HL^PSIVORA
+14 DO UNL^PSSLOCK(DFN,ON)
+15 QUIT
+1 IF $GET(PSIVALT)=1
IF '$GET(PSJUNDC)
KILL DA,DIR
SET DIR(0)="55.04,.04"
DO ^DIR
KILL DA,DIR
SET PSIVAL=$SELECT($DATA(DIRUT):"",1:Y)
+2 QUIT
LOG ;Record activity log comments.
+1 if $GET(PSIVALT)=2
SET PSIVAL="Action taken using OE/RR options."
DO ENTACT^PSIVAL
+2 KILL DA,DIE,DR
SET DA(2)=DFN
SET DA(1)=+ON55
SET DA=PSIVLN
SET DIE="^PS(55,"_DFN_",""IV"","_+ON55_",""A"","
SET DR=".02////"_PSIVREA_";.03////"_$PIECE(^VA(200,DUZ,0),U)_";.04////^S X=$G(PSIVAL)"_";.06////"_DUZ
DO ^DIE
+3 ;* Record the stop dates
DO STOP^PSIVORAL
+4 QUIT
PRNT ; DISPLAY IV ORDER AND PRINT MESSAGE
+1 NEW PSJLINE,PSJOC
SET PSJLINE=1
+2 DO DSPLORDV^PSJLMUT1(DFN,ON)
+3 FOR X=0:0
SET X=$ORDER(PSJOC(ON,X))
if 'X
QUIT
Begin DoDot:1
+4 WRITE !,$GET(PSJOC(ON,X))
End DoDot:1
+5 WRITE !," ***** NO ACTION TAKEN ON ORDER *****",!
+6 QUIT
CHKCOM ;Check to see if order is part of complex order series.
+1 NEW PSJSTAT
+2 SET PSJCOM=$PIECE($GET(^PS(55,PSGP,"IV",+ON,.2)),U,8)
SET COMFLG=0
SET PSJSTAT=$PIECE($GET(^(0)),"^",17)
+3 if 'PSJCOM
QUIT
IF "DE"[PSJSTAT
QUIT
+4 NEW PSJLINE,PSJOC
SET PSJLINE=1
+5 DO DSPLORDV^PSJLMUT1(DFN,ON)
+6 WRITE !
FOR X=0:0
SET X=$ORDER(PSJOC(ON,X))
if 'X
QUIT
Begin DoDot:1
+7 WRITE !,$GET(PSJOC(ON,X))
End DoDot:1
+8 WRITE !,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)."
DO CMPLX^PSJCOM1(DFN,PSJCOM,ON)
+9 FOR
WRITE !!,"Do you want to discontinue this series of complex orders"
SET %=1
DO YN^DICN
if %
QUIT
+10 IF %'=1
SET COMFLG=1
QUIT
+11 NEW O,OO
SET O=0
SET OO=""
FOR
SET O=$ORDER(^PS(55,"ACX",PSJCOM,O))
if 'O
QUIT
FOR
SET OO=$ORDER(^PS(55,"ACX",PSJCOM,O,OO))
if OO=""
QUIT
Begin DoDot:1
+12 if OO=ON
QUIT
IF '$$LS^PSSLOCK(DFN,OO)
SET COMFLG=1
QUIT
End DoDot:1
if COMFLG
QUIT
+13 if COMFLG
QUIT
+14 NEW O,OO
SET O=0
SET OO=""
FOR
SET O=$ORDER(^PS(55,"ACX",PSJCOM,O))
if 'O
QUIT
FOR
SET OO=$ORDER(^PS(55,"ACX",PSJCOM,O,OO))
if OO=""
QUIT
Begin DoDot:1
+15 IF (OO["U")
NEW PSGORD
SET PSGORD=OO
DO AC^PSGOECS
+16 IF (OO["V")
NEW PSGORD
SET (ON,PSGORD)=OO
DO SPDCIV^PSIVSPDC
+17 DO UNL^PSSLOCK(DFN,PSGORD)
End DoDot:1
