SROREA1 ;B'HAM ISC/MAM - DELAY REASONS, ONE SPECIALTY ; [ 04/04/00 11:54 AM ]
;;3.0; Surgery ;**94**;24 Jun 93
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
S SRSDATE=SRSD-.0001,SREDT=SRED+.9999
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
S CAUSE=0 F S CAUSE=$O(^TMP("SR",$J,CAUSE)) Q:'CAUSE!(SRSOUT) D CAUSE
Q:SRSOUT
W !!,?3,"TOTAL DELAYS FOR "_SRSSNM,?65,$J($P(^TMP("SR",$J),"^"),5),!
Q
UTIL I '$D(^SRF(SRTN,.2)) Q
I '$P(^SRF(SRTN,.2),"^",12) Q
I '$O(^SRF(SRTN,17,0)) Q
S Y=$P(^SRF(SRTN,0),"^",4) I Y'=SRSS Q
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
Q
SETUT ; set ^TMP
I '$D(^TMP("SR",$J)) S ^TMP("SR",$J)=0
I '$D(^TMP("SR",$J,CAUSE)) S ^TMP("SR",$J,CAUSE)=0
S ^TMP("SR",$J)=^TMP("SR",$J)+1,^TMP("SR",$J,CAUSE)=^TMP("SR",$J,CAUSE)+1
Q
CAUSE I $Y+4>IOSL D PAGE I SRSOUT Q
S SRCAUS=$P(^SRO(132.4,CAUSE,0),"^") W !,SRCAUS,?65,$J($P(^TMP("SR",$J,CAUSE),"^"),5)
Q
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
I X["?" W !!,"Enter RETURN to continue printing this report, or '^' to exit from this option." G PAGE
HDR ; print heading
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
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
I $E(IOST)="P" W !,?(80-$L(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE"
W !,?28,"REPORT OF DELAY REASONS",!,?27,"FROM "_X_" TO "_Y,!,?(80-$L(SRSSNM)\2),SRSSNM
I $E(IOST)="P" W !!,?21,"REVIEWED BY:",?45,"DATE REVIEWED:"
W !! F LINE=1:1:80 W "="
W ! I SRHDR D CAUSE
S SRHDR=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREA1 1939 printed Dec 13, 2024@02:45:41 Page 2
SROREA1 ;B'HAM ISC/MAM - DELAY REASONS, ONE SPECIALTY ; [ 04/04/00 11:54 AM ]
+1 ;;3.0; Surgery ;**94**;24 Jun 93
+2 SET SRSSNM=$PIECE(^SRO(137.45,SRSS,0),"^")
SET (PAGE,SRSOUT,SRHDR)=0
KILL ^TMP("SR",$JOB),^TMP("SRT",$JOB)
SET ^TMP("SR",$JOB)=0
SET ^TMP("SRT",$JOB)=0
DO HDR
if SRSOUT
QUIT
+3 SET SRSDATE=SRSD-.0001
SET SREDT=SRED+.9999
+4 FOR
SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))
if 'SRSDATE!(SRSDATE>SREDT)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDATE,SRTN))
if 'SRTN
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
DO UTIL
+5 SET CAUSE=0
FOR
SET CAUSE=$ORDER(^TMP("SR",$JOB,CAUSE))
if 'CAUSE!(SRSOUT)
QUIT
DO CAUSE
+6 if SRSOUT
QUIT
+7 WRITE !!,?3,"TOTAL DELAYS FOR "_SRSSNM,?65,$JUSTIFY($PIECE(^TMP("SR",$JOB),"^"),5),!
+8 QUIT
UTIL IF '$DATA(^SRF(SRTN,.2))
QUIT
+1 IF '$PIECE(^SRF(SRTN,.2),"^",12)
QUIT
+2 IF '$ORDER(^SRF(SRTN,17,0))
QUIT
+3 SET Y=$PIECE(^SRF(SRTN,0),"^",4)
IF Y'=SRSS
QUIT
+4 SET SRDC=0
FOR I=0:0
SET SRDC=$ORDER(^SRF(SRTN,17,SRDC))
if 'SRDC
QUIT
SET CAUSE=$PIECE(^SRF(SRTN,17,SRDC,0),"^")
SET SRDEL=$PIECE(^(0),"^",2)
DO SETUT
+5 QUIT
SETUT ; set ^TMP
+1 IF '$DATA(^TMP("SR",$JOB))
SET ^TMP("SR",$JOB)=0
+2 IF '$DATA(^TMP("SR",$JOB,CAUSE))
SET ^TMP("SR",$JOB,CAUSE)=0
+3 SET ^TMP("SR",$JOB)=^TMP("SR",$JOB)+1
SET ^TMP("SR",$JOB,CAUSE)=^TMP("SR",$JOB,CAUSE)+1
+4 QUIT
CAUSE IF $Y+4>IOSL
DO PAGE
IF SRSOUT
QUIT
+1 SET SRCAUS=$PIECE(^SRO(132.4,CAUSE,0),"^")
WRITE !,SRCAUS,?65,$JUSTIFY($PIECE(^TMP("SR",$JOB,CAUSE),"^"),5)
+2 QUIT
PAGE SET X=""
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 IF X["?"
WRITE !!,"Enter RETURN to continue printing this report, or '^' to exit from this option."
GOTO PAGE
HDR ; print heading
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 SET X=$EXTRACT(SRSD,4,5)_"/"_$EXTRACT(SRSD,6,7)_"/"_$EXTRACT(SRSD,2,3)
SET Y=$EXTRACT(SRED,4,5)_"/"_$EXTRACT(SRED,6,7)_"/"_$EXTRACT(SRED,2,3)
SET PAGE=PAGE+1
IF $Y
WRITE @IOF
+3 IF $EXTRACT(IOST)="P"
WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,?70,"PAGE: "_PAGE,!,?32,"SURGICAL SERVICE"
+4 WRITE !,?28,"REPORT OF DELAY REASONS",!,?27,"FROM "_X_" TO "_Y,!,?(80-$LENGTH(SRSSNM)\2),SRSSNM
+5 IF $EXTRACT(IOST)="P"
WRITE !!,?21,"REVIEWED BY:",?45,"DATE REVIEWED:"
+6 WRITE !!
FOR LINE=1:1:80
WRITE "="
+7 WRITE !
IF SRHDR
DO CAUSE
+8 SET SRHDR=1
+9 QUIT
