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

SROUTL1.m

Go to the documentation of this file.
  1. SROUTL1 ;BIR/ADM - UTILITY ROUTINE ;10/05/04
  1. ;;3.0; Surgery ;**134**;24 Jun 93
  1. ATT ; check for attend surg when completing case
  1. I $P($G(^SRF(DA,.1)),"^",13) Q
  1. D ASK I '$P($G(^SRF(DA,.1)),"^",13) K X
  1. Q
  1. ASK N SREQ,X,Y
  1. D EN^DDIOL("The Attending Surgeon field has not been entered. You must first enter the",,"!!")
  1. D EN^DDIOL("Attending Surgeon before the computer will accept entry of the Time Patient",,"!")
  1. D EN^DDIOL("Out of O.R.",,"!")
  1. K DIR S DIR("A",1)="",DIR("A")="Attending Surgeon",DIR(0)="130,.164" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
  1. I +Y S SREQ(130,DA_",",.164)=+Y D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
  1. Q
  1. ATTP ; check for attend provider when completing non-OR procedure
  1. I $P($G(^SRF(DA,"NON")),"^",7) Q
  1. D ASKP I '$P($G(^SRF(DA,"NON")),"^",7) K X
  1. Q
  1. ASKP N SREQ,X,Y
  1. D EN^DDIOL("The Attending Provider field has not been entered. You must first enter",,"!!")
  1. D EN^DDIOL("the Attending Provider before the computer will accept entry of the Time",,"!")
  1. D EN^DDIOL("Procedure Ended.",,"!")
  1. K DIR S DIR("A",1)="",DIR("A")="Attending Provider",DIR(0)="130,124" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
  1. I +Y S SREQ(130,DA_",",124)=+Y D FILE^DIE("","SREQ","^TMP(""SR"",$J)")
  1. Q