Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGOEVS

PSGOEVS.m

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