- SROPRI2 ;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),^TMP("SR",$J) S SRHDR=0
- 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")
- 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 SRSS="" D RET Q
- S SRHDR=1,SRSS=0 F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRSOUT) D RET S PRIOR=0 D NO6 F S PRIOR=$O(^TMP("SR",$J,SRSS,PRIOR)) D:PRIOR="" TOT Q:PRIOR=""!(SRSOUT) D PRINT
- I $E(IOST)'="P",'SRSOUT 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),SP=$S(SP:$P(^SRO(137.45,SP,0),"^"),1:"SPECIALTY NOT ENTERED")
- S ^TMP("SRLIST",$J,X)=^TMP("SRLIST",$J,X)+1,^TMP("SRLIST",$J)=^TMP("SRLIST",$J)+1
- I '$D(^TMP("SR",$J,SP)) S ^TMP("SR",$J,SP)=0,MM="" F S MM=$O(SRCODE(MM)) Q:MM="" S ^TMP("SR",$J,SP,SRCODE(MM))=0
- I '$D(^TMP("SR",$J,SP,X)) S ^TMP("SR",$J,SP,X)=0
- S ^TMP("SR",$J,SP)=^TMP("SR",$J,SP)+1,^TMP("SR",$J,SP,X)=^TMP("SR",$J,SP,X)+1
- Q
- RET 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 !!,"Press RETURN to continue with the List of Surgical Cases sorted by Surgical",!,"Priority, or '^' if you do not want to review any additional information." G RET
- I 'SRHDR 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,!
- I SRHDR W !,?(80-$L(SRSS)\2),SRSS,!
- Q
- PRINT ; print information for specialty
- W !,?24,PRIOR,?50,$J(^TMP("SR",$J,SRSS,PRIOR),6)
- Q
- TOT ; print total for the specialty
- W !!!,?24,"TOTAL SURGICAL CASES",?50,$J(^TMP("SR",$J,SRSS),6),!!!!!
- Q
- NO6 ; delete 6. PRIORITY NOT ENTERED
- I ^TMP("SR",$J,SRSS,"6. PRIORITY NOT ENTERED")=0 K ^TMP("SR",$J,SRSS,"6. PRIORITY NOT ENTERED")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPRI2 2544 printed Feb 19, 2025@00:11:43 Page 2
- SROPRI2 ;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),^TMP("SR",$JOB)
- SET SRHDR=0
- +3 SET ^TMP("SRLIST",$JOB)=0
- DO PLIST^SROPRIT
- 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 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)
- +8 WRITE !!!,?24,"TOTAL SURGICAL CASES: ",?50,$JUSTIFY(^TMP("SRLIST",$JOB),6),!!!!!
- +9 IF SRSS=""
- DO RET
- QUIT
- +10 SET SRHDR=1
- SET SRSS=0
- FOR
- SET SRSS=$ORDER(^TMP("SR",$JOB,SRSS))
- if SRSS=""!(SRSOUT)
- QUIT
- DO RET
- SET PRIOR=0
- DO NO6
- FOR
- SET PRIOR=$ORDER(^TMP("SR",$JOB,SRSS,PRIOR))
- if PRIOR=""
- DO TOT
- if PRIOR=""!(SRSOUT)
- QUIT
- DO PRINT
- +11 IF $EXTRACT(IOST)'="P"
- IF 'SRSOUT
- WRITE !!
- KILL DIR
- SET DIR(0)="FOA"
- SET DIR("A")=" Press RETURN to continue. "
- DO ^DIR
- +12 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)
- SET SP=$SELECT(SP:$PIECE(^SRO(137.45,SP,0),"^"),1:"SPECIALTY NOT ENTERED")
- +4 SET ^TMP("SRLIST",$JOB,X)=^TMP("SRLIST",$JOB,X)+1
- SET ^TMP("SRLIST",$JOB)=^TMP("SRLIST",$JOB)+1
- +5 IF '$DATA(^TMP("SR",$JOB,SP))
- SET ^TMP("SR",$JOB,SP)=0
- SET MM=""
- FOR
- SET MM=$ORDER(SRCODE(MM))
- if MM=""
- QUIT
- SET ^TMP("SR",$JOB,SP,SRCODE(MM))=0
- +6 IF '$DATA(^TMP("SR",$JOB,SP,X))
- SET ^TMP("SR",$JOB,SP,X)=0
- +7 SET ^TMP("SR",$JOB,SP)=^TMP("SR",$JOB,SP)+1
- SET ^TMP("SR",$JOB,SP,X)=^TMP("SR",$JOB,SP,X)+1
- +8 QUIT
- RET 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 !!,"Press RETURN to continue with the List of Surgical Cases sorted by Surgical",!,"Priority, or '^' if you do not want to review any additional information."
- GOTO RET
- +2 IF 'SRHDR
- 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 IF SRHDR
- WRITE !,?(80-$LENGTH(SRSS)\2),SRSS,!
- +5 QUIT
- PRINT ; print information for specialty
- +1 WRITE !,?24,PRIOR,?50,$JUSTIFY(^TMP("SR",$JOB,SRSS,PRIOR),6)
- +2 QUIT
- TOT ; print total for the specialty
- +1 WRITE !!!,?24,"TOTAL SURGICAL CASES",?50,$JUSTIFY(^TMP("SR",$JOB,SRSS),6),!!!!!
- +2 QUIT
- NO6 ; delete 6. PRIORITY NOT ENTERED
- +1 IF ^TMP("SR",$JOB,SRSS,"6. PRIORITY NOT ENTERED")=0
- KILL ^TMP("SR",$JOB,SRSS,"6. PRIORITY NOT ENTERED")
- +2 QUIT
