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

SROREA1.m

Go to the documentation of this file.
  1. SROREA1 ;B'HAM ISC/MAM - DELAY REASONS, ONE SPECIALTY ; [ 04/04/00 11:54 AM ]
  1. ;;3.0; Surgery ;**94**;24 Jun 93
  1. S SRSSNM=$P(^SRO(137.45,SRSS,0),"^"),(PAGE,SRSOUT,SRHDR)=0 K ^TMP("SR",$J),^TMP("SRT",$J) S ^TMP("SR",$J)=0,^TMP("SRT",$J)=0 D HDR Q:SRSOUT
  1. S SRSDATE=SRSD-.0001,SREDT=SRED+.9999
  1. F S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
  1. S CAUSE=0 F S CAUSE=$O(^TMP("SR",$J,CAUSE)) Q:'CAUSE!(SRSOUT) D CAUSE
  1. Q:SRSOUT
  1. W !!,?3,"TOTAL DELAYS FOR "_SRSSNM,?65,$J($P(^TMP("SR",$J),"^"),5),!
  1. Q
  1. UTIL I '$D(^SRF(SRTN,.2)) Q
  1. I '$P(^SRF(SRTN,.2),"^",12) Q
  1. I '$O(^SRF(SRTN,17,0)) Q
  1. S Y=$P(^SRF(SRTN,0),"^",4) I Y'=SRSS Q
  1. S SRDC=0 F I=0:0 S SRDC=$O(^SRF(SRTN,17,SRDC)) Q:'SRDC S CAUSE=$P(^SRF(SRTN,17,SRDC,0),"^"),SRDEL=$P(^(0),"^",2) D SETUT
  1. Q
  1. SETUT ; set ^TMP
  1. I '$D(^TMP("SR",$J)) S ^TMP("SR",$J)=0
  1. I '$D(^TMP("SR",$J,CAUSE)) S ^TMP("SR",$J,CAUSE)=0
  1. S ^TMP("SR",$J)=^TMP("SR",$J)+1,^TMP("SR",$J,CAUSE)=^TMP("SR",$J,CAUSE)+1
  1. Q
  1. CAUSE I $Y+4>IOSL D PAGE I SRSOUT Q
  1. S SRCAUS=$P(^SRO(132.4,CAUSE,0),"^") W !,SRCAUS,?65,$J($P(^TMP("SR",$J,CAUSE),"^"),5)
  1. Q
  1. PAGE S X="" I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
  1. I X["?" W !!,"Enter RETURN to continue printing this report, or '^' to exit from this option." G PAGE
  1. HDR ; print heading
  1. I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
  1. S X=$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3),Y=$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3),PAGE=PAGE+1 I $Y W @IOF
  1. I $E(IOST)="P" W !,?(80-$L(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE"
  1. W !,?28,"REPORT OF DELAY REASONS",!,?27,"FROM "_X_" TO "_Y,!,?(80-$L(SRSSNM)\2),SRSSNM
  1. I $E(IOST)="P" W !!,?21,"REVIEWED BY:",?45,"DATE REVIEWED:"
  1. W !! F LINE=1:1:80 W "="
  1. W ! I SRHDR D CAUSE
  1. S SRHDR=1
  1. Q