- SROPRI1 ;B'HAM ISC/MAM - TOTAL OPERATIONS (BY PRIORITY) ; [ 07/27/98 2:33 PM ]
- ;;3.0; Surgery ;**50**;24 Jun 93
- U IO K ^TMP("SRLIST",$J) S ^TMP("SRLIST",$J)=0 D PLIST^SROPRIT
- S X="" F S X=$O(SRCODE(X)) Q:X="" S ^TMP("SRLIST",$J,SRCODE(X))=0
- S SRLINE="" F X=1:1:80 S SRLINE=SRLINE_"_"
- F S SRD=$O(^SRF("AC",SRD)) Q:SRD=""!(SRD>SRED1) S SRTN=0 F S SRTN=$O(^SRF("AC",SRD,SRTN)) Q:SRTN="" I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D UTIL
- I ^TMP("SRLIST",$J,"6. PRIORITY NOT ENTERED")=0 K ^TMP("SRLIST",$J,"6. PRIORITY NOT ENTERED")
- S SRSS=$P(^SRO(137.45,SRSS,0),"^")
- D HDR Q:SRSOUT S X=0 F S X=$O(^TMP("SRLIST",$J,X)) Q:X="" W !,?24,X,?50,$J(^(X),6)
- W !!!,?24,"TOTAL SURGICAL CASES: ",?50,$J(^TMP("SRLIST",$J),6)
- I $E(IOST)'="P" W !!!! K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR
- Q
- UTIL ; set UTILITY("SRLIST",$J
- Q:$P($G(^SRF(SRTN,.2)),"^",12)=""
- S SR(0)=^SRF(SRTN,0),X=$P(SR(0),"^",10) S:X="" X="ZZ" S X=SRCODE(X)
- S SP=$P(SR(0),"^",4) I SP'=SRSS Q
- S ^TMP("SRLIST",$J,X)=^TMP("SRLIST",$J,X)+1,^TMP("SRLIST",$J)=^TMP("SRLIST",$J)+1
- Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- W:$Y @IOF W !,?(80-$L(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE",!,?21,"TOTAL OPERATIONS BY SURGICAL PRIORITY"
- W !,?(80-$L(SRFRTO)\2),SRFRTO W:$E(IOST)="P" !,?28,SRPRINT W !,SRLINE,!
- W !,?(80-$L(SRSS)\2),SRSS,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPRI1 1386 printed Feb 19, 2025@00:11:42 Page 2
- SROPRI1 ;B'HAM ISC/MAM - TOTAL OPERATIONS (BY PRIORITY) ; [ 07/27/98 2:33 PM ]
- +1 ;;3.0; Surgery ;**50**;24 Jun 93
- +2 USE IO
- KILL ^TMP("SRLIST",$JOB)
- SET ^TMP("SRLIST",$JOB)=0
- DO PLIST^SROPRIT
- +3 SET X=""
- FOR
- SET X=$ORDER(SRCODE(X))
- if X=""
- QUIT
- SET ^TMP("SRLIST",$JOB,SRCODE(X))=0
- +4 SET SRLINE=""
- FOR X=1:1:80
- SET SRLINE=SRLINE_"_"
- +5 FOR
- SET SRD=$ORDER(^SRF("AC",SRD))
- if SRD=""!(SRD>SRED1)
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRD,SRTN))
- if SRTN=""
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$DIV^SROUTL0(SRTN)
- DO UTIL
- +6 IF ^TMP("SRLIST",$JOB,"6. PRIORITY NOT ENTERED")=0
- KILL ^TMP("SRLIST",$JOB,"6. PRIORITY NOT ENTERED")
- +7 SET SRSS=$PIECE(^SRO(137.45,SRSS,0),"^")
- +8 DO HDR
- if SRSOUT
- QUIT
- SET X=0
- FOR
- SET X=$ORDER(^TMP("SRLIST",$JOB,X))
- if X=""
- QUIT
- WRITE !,?24,X,?50,$JUSTIFY(^(X),6)
- +9 WRITE !!!,?24,"TOTAL SURGICAL CASES: ",?50,$JUSTIFY(^TMP("SRLIST",$JOB),6)
- +10 IF $EXTRACT(IOST)'="P"
- WRITE !!!!
- KILL DIR
- SET DIR(0)="FOA"
- SET DIR("A")=" Press RETURN to continue. "
- DO ^DIR
- +11 QUIT
- UTIL ; set UTILITY("SRLIST",$J
- +1 if $PIECE($GET(^SRF(SRTN,.2)),"^",12)=""
- QUIT
- +2 SET SR(0)=^SRF(SRTN,0)
- SET X=$PIECE(SR(0),"^",10)
- if X=""
- SET X="ZZ"
- SET X=SRCODE(X)
- +3 SET SP=$PIECE(SR(0),"^",4)
- IF SP'=SRSS
- QUIT
- +4 SET ^TMP("SRLIST",$JOB,X)=^TMP("SRLIST",$JOB,X)+1
- SET ^TMP("SRLIST",$JOB)=^TMP("SRLIST",$JOB)+1
- +5 QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 if $Y
- WRITE @IOF
- WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,!,?32,"SURGICAL SERVICE",!,?21,"TOTAL OPERATIONS BY SURGICAL PRIORITY"
- +3 WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO
- if $EXTRACT(IOST)="P"
- WRITE !,?28,SRPRINT
- WRITE !,SRLINE,!
- +4 WRITE !,?(80-$LENGTH(SRSS)\2),SRSS,!
- +5 QUIT
