- SROREA2 ;B'HAM ISC/MAM - DELAY REASONS, ALL SPECIALTIES ; [ 04/04/00 11:54 AM ]
- ;;3.0; Surgery ;**94**;24 Jun 93
- S (PAGE,SRSOUT,SRHDR)=0 K ^TMP("SR",$J),^TMP("SRT",$J) S (^TMP("SR",$J),^TMP("SRT",$J))=0 I 'SROTOT 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
- I ^TMP("SR",$J)=0 D:SROTOT HDR W !!,"No data for selected date range." Q
- I SROTOT D ^SROREA Q
- S SRSS=0 F S SRSS=$O(^TMP("SRT",$J,SRSS)) Q:SRSS=""!(SRSOUT) D SPEC
- Q:SRSOUT D ^SROREA
- Q
- UTIL I '$D(^SRF(SRTN,.2)) Q
- I '$P(^SRF(SRTN,.2),"^",12) Q
- I '$O(^SRF(SRTN,17,0)) Q
- S SRSS=$P(^SRF(SRTN,0),"^",4),SRSS=$S('SRSS:"ZZ",1:$P(^SRO(137.45,SRSS,0),"^"))
- S SRDC=0 F 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 I '$D(^TMP("SRT",$J,SRSS)) S ^TMP("SRT",$J,SRSS)=0
- I '$D(^TMP("SRT",$J,SRSS,CAUSE)) S ^TMP("SRT",$J,SRSS,CAUSE)=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
- S ^TMP("SRT",$J,SRSS)=^TMP("SRT",$J,SRSS)+1,^TMP("SRT",$J,SRSS,CAUSE)=^TMP("SRT",$J,SRSS,CAUSE)+1
- Q
- SPEC I $Y+6>IOSL D PAGE Q:SRSOUT
- S SRSSNM=$S(SRSS'="ZZ":SRSS,1:"SURGICAL SPECIALTY NOT ENTERED")
- S SRCOL=80-$L(SRSSNM)\2,SRSS1="" F UL=1:1:$L(SRSSNM) S SRSS1=SRSS1_"-"
- W !!,?SRCOL,SRSSNM,!,?SRCOL,SRSS1,!
- S CAUSE=0 F S CAUSE=$O(^TMP("SRT",$J,SRSS,CAUSE)) Q:'CAUSE!(SRSOUT) D CAUSE
- Q:SRSOUT W !!,?3,"TOTAL DELAYS FOR "_SRSSNM,?65,$J($P(^TMP("SRT",$J,SRSS),"^"),5),!
- 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("SRT",$J,SRSS,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
- I $E(IOST)="P" W !!,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!! F LINE=1:1:80 W "="
- I SRHDR,CAUSE W !!,?SRCOL,SRSSNM,!,?SRCOL,SRSS1,!
- S SRHDR=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREA2 2538 printed Feb 19, 2025@00:12:12 Page 2
- SROREA2 ;B'HAM ISC/MAM - DELAY REASONS, ALL SPECIALTIES ; [ 04/04/00 11:54 AM ]
- +1 ;;3.0; Surgery ;**94**;24 Jun 93
- +2 SET (PAGE,SRSOUT,SRHDR)=0
- KILL ^TMP("SR",$JOB),^TMP("SRT",$JOB)
- SET (^TMP("SR",$JOB),^TMP("SRT",$JOB))=0
- IF 'SROTOT
- 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 IF ^TMP("SR",$JOB)=0
- if SROTOT
- DO HDR
- WRITE !!,"No data for selected date range."
- QUIT
- +6 IF SROTOT
- DO ^SROREA
- QUIT
- +7 SET SRSS=0
- FOR
- SET SRSS=$ORDER(^TMP("SRT",$JOB,SRSS))
- if SRSS=""!(SRSOUT)
- QUIT
- DO SPEC
- +8 if SRSOUT
- QUIT
- DO ^SROREA
- +9 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 SRSS=$PIECE(^SRF(SRTN,0),"^",4)
- SET SRSS=$SELECT('SRSS:"ZZ",1:$PIECE(^SRO(137.45,SRSS,0),"^"))
- +4 SET SRDC=0
- FOR
- 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 IF '$DATA(^TMP("SRT",$JOB,SRSS))
- SET ^TMP("SRT",$JOB,SRSS)=0
- +1 IF '$DATA(^TMP("SRT",$JOB,SRSS,CAUSE))
- SET ^TMP("SRT",$JOB,SRSS,CAUSE)=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 SET ^TMP("SRT",$JOB,SRSS)=^TMP("SRT",$JOB,SRSS)+1
- SET ^TMP("SRT",$JOB,SRSS,CAUSE)=^TMP("SRT",$JOB,SRSS,CAUSE)+1
- +5 QUIT
- SPEC IF $Y+6>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- +1 SET SRSSNM=$SELECT(SRSS'="ZZ":SRSS,1:"SURGICAL SPECIALTY NOT ENTERED")
- +2 SET SRCOL=80-$LENGTH(SRSSNM)\2
- SET SRSS1=""
- FOR UL=1:1:$LENGTH(SRSSNM)
- SET SRSS1=SRSS1_"-"
- +3 WRITE !!,?SRCOL,SRSSNM,!,?SRCOL,SRSS1,!
- +4 SET CAUSE=0
- FOR
- SET CAUSE=$ORDER(^TMP("SRT",$JOB,SRSS,CAUSE))
- if 'CAUSE!(SRSOUT)
- QUIT
- DO CAUSE
- +5 if SRSOUT
- QUIT
- WRITE !!,?3,"TOTAL DELAYS FOR "_SRSSNM,?65,$JUSTIFY($PIECE(^TMP("SRT",$JOB,SRSS),"^"),5),!
- +6 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("SRT",$JOB,SRSS,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
- +5 IF $EXTRACT(IOST)="P"
- WRITE !!,?21,"REVIEWED BY:",?45,"DATE REVIEWED:",!!
- FOR LINE=1:1:80
- WRITE "="
- +6 IF SRHDR
- IF CAUSE
- WRITE !!,?SRCOL,SRSSNM,!,?SRCOL,SRSS1,!
- +7 SET SRHDR=1
- +8 QUIT
