PSGOEVS ;BIR/CML3-SPEED VERIFY SELECTED ORDERS ;05 DEC 97 / 8:43 AM
;;5.0; INPATIENT MEDICATIONS ;**29,110**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191
; Reference to ^PSSLOCK is supported by DBIA #2789
;
EN ;
I 'PSJSYSU W $C(7),!!,"THIS FUNCTION NOT AVAILABLE TO WARD STAFF." H 3 Q
I '$D(PSJOCNT) W !!,"Speed verify is not available for IVs." H 3 Q
W !,"Note: Only orders created by a RENEW can be speed verified."
D FULL^VALM1
EN2 S PSGONV=PSJOCNT,PSJSPEED=1 D NOW^%DTC S PSGDT=+$E(%,1,2)
S PSGONW="V",PSGLMT=PSGONV D ENWO^PSGON S PSJRB=X I "^"[X K X G DONE
F PSGOEVS=1:1:PSGODDD F PSGOEVS1=1:1 S PSGOEVS2=$P(PSGODDD(PSGOEVS),",",PSGOEVS1) Q:'PSGOEVS2 D
.S PSGORD=^TMP("PSJON",$J,PSGOEVS2)
.I $$CHKIV Q
.I $$CHKVER Q
.;I '$$ACTIONS Q
.N PSJCOM I $$CHKCOM Q
.I '$$RENEWED Q
.I $$FROMOERR Q
.D VERIFY(PSJSPEED)
;
DONE ;
K %,DA,N,PSGAL,PSGID,PSGLMT,PSGOD,PSGODDD,PSGOEVS,PSGOEVS1,PSGOEVS2
K PSGONW,PSGORD,PSJRB,PSJRENEW,PSJSPEED
N DIR S DIR(0)="E" D ^DIR
Q
;
RENEWED() ; was it created by a renew?
S PSJRENEW=1
I PSGORD'["P" D
.S PSJRB=$G(^PS(55,PSGP,5,+PSGORD,.2))
.S PSJRB=$$NAME(PSJRB)
.W !!," ",PSGOEVS2,". ",PSJRB
.I $P(^PS(55,PSGP,5,+PSGORD,0),"^",24)'="R" D NOTREN Q
E I PSGORD["P" D
.S PSJRB=$G(^PS(53.1,+PSGORD,.2))
.S PSJRB=$$NAME(PSJRB)
.W !!," ",PSGOEVS2,". ",PSJRB
.I $P(^PS(53.1,+PSGORD,0),"^",24)'="R" D NOTREN Q
Q PSJRENEW
;
VERIFY(PSJSPEED) ;
I '$$LS^PSSLOCK(PSGP,PSGORD) W !,"NO ACTION TAKEN ON ORDER",! ; lock single order
D GETUD^PSJLMGUD(PSGP,PSGORD),EN^PSGOEV(PSGORD)
D UNL^PSSLOCK(PSGP,PSGORD)
Q
;
CHKVER() ; check if already verified
I $D(^PS(55,PSGP,5,+PSGORD,4)),$P(^(4),"^",PSJSYSU) S N=$P(^(4),"^",+PSJSYSU),PSGOD=$P(^(4),"^",PSJSYSU+1)
I D VMSG H 2
Q $T
;
CHKIV() ; check if this order is an IV
I PSGORD["V"
I W !," Order ",PSGOEVS2," is an IV order.",! H 2
Q $T
CHKCOM() ; Check if this order is a complex order
S PSJCOM=0
I PSGORD=+PSGORD S PSJCOM=PSGORD W !," Order ",PSGOEVS2," is part of a complex order series, No change made.",! H 2 Q PSJCOM
S PSJCOM=$S(PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,8),1:$P($G(^PS(53.1,+PSGORD,.2)),U,8))
I PSJCOM W !," Order ",PSGOEVS2," is part of a complex order series, No change made.",! H 2
Q PSJCOM
;
VMSG ;
S N=$$ENNPN^PSGMI(N),PSJRB=$G(^PS(55,PSGP,5,+PSGORD,.2))
S PSJRB=$$NAME(PSJRB)
W !!," ",PSGOEVS2,". ",PSJRB,!," was verified by ",N," on "
W $$ENDTC^PSGMI(PSGOD),"."
Q
NOTREN ;
W !," was not created from a renew, No change made!" H 2
S PSJRENEW=0
Q
;
NAME(PSJRB) ;
I PSJRB S PSJRB=$$DRUGN_" "_$P(PSJRB,"^",2)
E S PSJRB="ORDERABLE ITEM - NOT FOUND"
Q PSJRB
;
DRUGN() Q $P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")
;
ACTIONS() ;
;W !," ****** ",$$ENACTION^PSGOE1(PSGP,PSGORD)
I $$ENACTION^PSGOE1(PSGP,PSGORD)["V"
E W !,PSGOEVS2,". CAN'T BE VERIFIED FOR SOME REASON! ",PSGACT
Q $T
;
FROMOERR() ; is it pending from OERR?
I PSGORD["P"&($P($G(^PS(53.1,+PSGORD,0)),"^",9)="P")
I D
.W !," is Pending from Order Entry/Results Reporting"
.W ", No Change made." H 2
Q $T
PSGOEVS ;BIR/CML3-SPEED VERIFY SELECTED ORDERS ;05 DEC 97 / 8:43 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**29,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 ;
+1 IF 'PSJSYSU
WRITE $CHAR(7),!!,"THIS FUNCTION NOT AVAILABLE TO WARD STAFF."
HANG 3
QUIT
+2 IF '$DATA(PSJOCNT)
WRITE !!,"Speed verify is not available for IVs."
HANG 3
QUIT
+3 WRITE !,"Note: Only orders created by a RENEW can be speed verified."
+4 DO FULL^VALM1
EN2 SET PSGONV=PSJOCNT
SET PSJSPEED=1
DO NOW^%DTC
SET PSGDT=+$EXTRACT(%,1,2)
+1 SET PSGONW="V"
SET PSGLMT=PSGONV
DO ENWO^PSGON
SET PSJRB=X
IF "^"[X
KILL X
GOTO DONE
+2 FOR PSGOEVS=1:1:PSGODDD
FOR PSGOEVS1=1:1
SET PSGOEVS2=$PIECE(PSGODDD(PSGOEVS),",",PSGOEVS1)
IF 'PSGOEVS2
QUIT
Begin DoDot:1
+3 SET PSGORD=^TMP("PSJON",$JOB,PSGOEVS2)
+4 IF $$CHKIV
QUIT
+5 IF $$CHKVER
QUIT
+6 ;I '$$ACTIONS Q
+7 NEW PSJCOM
IF $$CHKCOM
QUIT
+8 IF '$$RENEWED
QUIT
+9 IF $$FROMOERR
QUIT
+10 DO VERIFY(PSJSPEED)
End DoDot:1
+11 ;
DONE ;
+1 KILL %,DA,N,PSGAL,PSGID,PSGLMT,PSGOD,PSGODDD,PSGOEVS,PSGOEVS1,PSGOEVS2
+2 KILL PSGONW,PSGORD,PSJRB,PSJRENEW,PSJSPEED
+3 NEW DIR
SET DIR(0)="E"
DO ^DIR
+4 QUIT
+5 ;
RENEWED() ; was it created by a renew?
+1 SET PSJRENEW=1
+2 IF PSGORD'["P"
Begin DoDot:1
+3 SET PSJRB=$GET(^PS(55,PSGP,5,+PSGORD,.2))
+4 SET PSJRB=$$NAME(PSJRB)
+5 WRITE !!," ",PSGOEVS2,". ",PSJRB
+6 IF $PIECE(^PS(55,PSGP,5,+PSGORD,0),"^",24)'="R"
DO NOTREN
QUIT
End DoDot:1
+7 IF '$TEST
IF PSGORD["P"
Begin DoDot:1
+8 SET PSJRB=$GET(^PS(53.1,+PSGORD,.2))
+9 SET PSJRB=$$NAME(PSJRB)
+10 WRITE !!," ",PSGOEVS2,". ",PSJRB
+11 IF $PIECE(^PS(53.1,+PSGORD,0),"^",24)'="R"
DO NOTREN
QUIT
End DoDot:1
+12 QUIT PSJRENEW
+13 ;
VERIFY(PSJSPEED) ;
+1 ; lock single order
IF '$$LS^PSSLOCK(PSGP,PSGORD)
WRITE !,"NO ACTION TAKEN ON ORDER",!
+2 DO GETUD^PSJLMGUD(PSGP,PSGORD)
DO EN^PSGOEV(PSGORD)
+3 DO UNL^PSSLOCK(PSGP,PSGORD)
+4 QUIT
+5 ;
CHKVER() ; check if already verified
+1 IF $DATA(^PS(55,PSGP,5,+PSGORD,4))
IF $PIECE(^(4),"^",PSJSYSU)
SET N=$PIECE(^(4),"^",+PSJSYSU)
SET PSGOD=$PIECE(^(4),"^",PSJSYSU+1)
+2 IF $TEST
DO VMSG
HANG 2
+3 QUIT $TEST
+4 ;
CHKIV() ; check if this order is an IV
+1 IF PSGORD["V"
+2 IF $TEST
WRITE !," Order ",PSGOEVS2," is an IV order.",!
HANG 2
+3 QUIT $TEST
CHKCOM() ; Check if this order is a complex order
+1 SET PSJCOM=0
+2 IF PSGORD=+PSGORD
SET PSJCOM=PSGORD
WRITE !," Order ",PSGOEVS2," is part of a complex order series, No change made.",!
HANG 2
QUIT PSJCOM
+3 SET PSJCOM=$SELECT(PSGORD["U":$PIECE($GET(^PS(55,PSGP,5,+PSGORD,.2)),U,8),1:$PIECE($GET(^PS(53.1,+PSGORD,.2)),U,8))
+4 IF PSJCOM
WRITE !," Order ",PSGOEVS2," is part of a complex order series, No change made.",!
HANG 2
+5 QUIT PSJCOM
+6 ;
VMSG ;
+1 SET N=$$ENNPN^PSGMI(N)
SET PSJRB=$GET(^PS(55,PSGP,5,+PSGORD,.2))
+2 SET PSJRB=$$NAME(PSJRB)
+3 WRITE !!," ",PSGOEVS2,". ",PSJRB,!," was verified by ",N," on "
+4 WRITE $$ENDTC^PSGMI(PSGOD),"."
+5 QUIT
NOTREN ;
+1 WRITE !," was not created from a renew, No change made!"
HANG 2
+2 SET PSJRENEW=0
+3 QUIT
+4 ;
NAME(PSJRB) ;
+1 IF PSJRB
SET PSJRB=$$DRUGN_" "_$P(PSJRB,"^",2)
+2 IF '$TEST
SET PSJRB="ORDERABLE ITEM - NOT FOUND"
+3 QUIT PSJRB
+4 ;
DRUGN() QUIT $PIECE($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")
+1 ;
ACTIONS() ;
+1 ;W !," ****** ",$$ENACTION^PSGOE1(PSGP,PSGORD)
+2 IF $$ENACTION^PSGOE1(PSGP,PSGORD)["V"
+3 IF '$TEST
WRITE !,PSGOEVS2,". CAN'T BE VERIFIED FOR SOME REASON! ",PSGACT
+4 QUIT $TEST
+5 ;
FROMOERR() ; is it pending from OERR?
+1 IF PSGORD["P"&($PIECE($GET(^PS(53.1,+PSGORD,0)),"^",9)="P")
+2 IF $TEST
Begin DoDot:1
+3 WRITE !," is Pending from Order Entry/Results Reporting"
+4 WRITE ", No Change made."
HANG 2
End DoDot:1
+5 QUIT $TEST
