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

SROPACT.m

Go to the documentation of this file.
  1. SROPACT ;B'HAM ISC/MAM - DAILY ACTIVITY LOG ; [ 09/22/98 11:36 AM ]
  1. ;;3.0; Surgery ;**77,50**;24 Jun 93
  1. W @IOF,! S SRSOUT=0 K %DT
  1. S %DT="AEPX",%DT("A")="Print the Report of Daily Activity for which Date ? " D ^%DT I Y<0 S SRSOUT=1 G END
  1. S SRSD=+Y,SRINST=SRSITE("SITE")
  1. D D^DIQ S SRDT1=Y S X1=SRSD,X2=1 D C^%DTC S SRET=X_".0559",Y=X,SRED=X_".9999" D D^DIQ S SRDT2=Y
  1. W !!,"This report will include all cases started between "_SRDT1_" at 6:00 AM",!,"and "_SRDT2_" at 5:59 AM."
  1. I $D(^XUSEC("SROCHIEF",+DUZ)) N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
  1. K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report to which Device ? ",%ZIS="QM"
  1. W !!,"It is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END
  1. I $D(IO("Q")) K IO("Q") S ZTDESC="Report of Daily OR Activities",ZTRTN="EN^SROPACT",(ZTSAVE("SRET"),ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRINST"),ZTSAVE("SRSITE*"),ZTSAVE("SRINSTP"))="" D ^%ZTLOAD G END
  1. EN ; entry when queued
  1. S Y=SRSD D D^DIQ S SRSDT=Y
  1. U IO S SRSDATE=SRSD-.0001,SRST=SRSD_".06" K ^TMP("SRACT",$J)
  1. F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:SRSDATE>SRED!('SRSDATE) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN D:$D(^SRF(SRTN,0))
  1. .I $D(^XUSEC("SROCHIEF",+DUZ)) I $$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
  1. .I '$D(^XUSEC("SROCHIEF",+DUZ)) I $$DIV^SROUTL0(SRTN) D UTIL
  1. D ^SROPAC0
  1. END I $E(IOST)'="P",'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
  1. W:$E(IOST)="P" @IOF K ^TMP("SRACT",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
  1. K SRTN D ^SRSKILL D ^%ZISC W @IOF
  1. Q
  1. UTIL ; set ^TMP("SRACT",$J)
  1. I '$D(^SRF(SRTN,.2)) Q
  1. I $P(^SRF(SRTN,.2),"^",10)="" Q
  1. S SRTIMEIN=$P(^SRF(SRTN,.2),"^",10) Q:SRTIMEIN<SRST I SRTIMEIN>SRET Q
  1. S SROR=$P(^SRF(SRTN,0),"^",2) S:'SROR SROR="OTHER"
  1. I SROR S SROR=$P(^SRS(SROR,0),"^"),SROR=$P(^SC(SROR,0),"^")
  1. S ^TMP("SRACT",$J,SROR,SRSDATE,SRTN)=""
  1. Q