SROAT2T ;B'HAM ISC/MAM - ATTENDING SURGEON CUMULATIVE ; [ 05/11/04 2:33 PM ]
;;3.0;Surgery;**50,129,182**;24 Jun 93;Build 49
S SRPAGE=1
D HDR Q:SRSOUT W !!,?1,"TOTAL CASES",?16,"ATTENDING CODE",!,?1,"-----------",?16,"--------------"
S PRINT=1,(HDR,CODE)="" F I=0:0 S CODE=$O(^TMP("SRTC",$J,CODE)) Q:CODE="" D PRINT
W !!,?1,$J(^TMP("SRTOT",$J),6),?16,"TOTAL CASES FROM "_$E(SRSD,4,5)_"/"_$E(SRSD,6,7)_"/"_$E(SRSD,2,3)_" TO "_$E(SRED,4,5)_"/"_$E(SRED,6,7)_"/"_$E(SRED,2,3)
I $E(IOST)'="P" D BREAK I SRSOUT Q
S PRINT=2,SRSS=0 F S SRSS=$O(^TMP("SRTOT",$J,SRSS)) Q:SRSS=""!(SRSOUT) D SPEC
Q
PRINT I 'CODE S SRCODE="ATTENDING/RES SUP CODE NOT ENTERED"
I CODE S Y=CODE,C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRCODE=Y
W !,?1,$J($S(PRINT=1:^TMP("SRTC",$J,CODE),1:^TMP("SRTOT",$J,SRSS,CODE)),6),?16,SRCODE
Q
HDR ; print heading
I +$Y W @IOF
W !,?(80-$L(SRINST)\2),SRINST,?76,"PAGE",!,?32,"SURGICAL SERVICE",?78,SRPAGE,!,?22,"ATTENDING SURGEON CUMULATIVE REPORT"
W !,?(80-$L(SRFRTO)\2),SRFRTO
I $E(IOST)="P" W !,?30,"DATE PRINTED: ",SRPRINT,!!,?8,"REVIEWED BY: ",?53,"DATE REVIEWED: "
S SRPAGE=SRPAGE+1 W ! F LINE=1:1:80 W "="
Q
BREAK W !!!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
I X["?" W !!,"Enter RETURN if you want to display the totals for each specialty, or '^' to",!,"exit from this report." G BREAK
Q
SPEC ; SPECIALTIES
S TOTAL=^TMP("SRTOT",$J,SRSS) I 'TOTAL Q
S SRSSN=$S($E(SRSS,1,2)="ZZ":"SPECIALTY NOT ENTERED",1:SRSS)
D HDR W !!,?(80-$L(SRSSN)\2),SRSSN,!!,?1,"TOTAL CASES",?16,"ATTENDING/RES SUP CODE",!,?1,"-----------",?16,"--------------"
S CODE="" F S CODE=$O(^TMP("SRTOT",$J,SRSS,CODE)) Q:CODE="" D PRINT
W !!,?1,$J(^TMP("SRTOT",$J,SRSS),6),?16,"TOTAL CASES FOR THIS SPECIALTY"
I $E(IOST)'="P" D BREAK I SRSOUT Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAT2T 1829 printed Nov 22, 2024@17:52:02 Page 2
SROAT2T ;B'HAM ISC/MAM - ATTENDING SURGEON CUMULATIVE ; [ 05/11/04 2:33 PM ]
+1 ;;3.0;Surgery;**50,129,182**;24 Jun 93;Build 49
+2 SET SRPAGE=1
+3 DO HDR
if SRSOUT
QUIT
WRITE !!,?1,"TOTAL CASES",?16,"ATTENDING CODE",!,?1,"-----------",?16,"--------------"
+4 SET PRINT=1
SET (HDR,CODE)=""
FOR I=0:0
SET CODE=$ORDER(^TMP("SRTC",$JOB,CODE))
if CODE=""
QUIT
DO PRINT
+5 WRITE !!,?1,$JUSTIFY(^TMP("SRTOT",$JOB),6),?16,"TOTAL CASES FROM "_$EXTRACT(SRSD,4,5)_"/"_$EXTRACT(SRSD,6,7)_"/"_$EXTRACT(SRSD,2,3)_" TO "_$EXTRACT(SRED,4,5)_"/"_$EXTRACT(SRED,6,7)_"/"_$EXTRACT(SRED,2,3)
+6 IF $EXTRACT(IOST)'="P"
DO BREAK
IF SRSOUT
QUIT
+7 SET PRINT=2
SET SRSS=0
FOR
SET SRSS=$ORDER(^TMP("SRTOT",$JOB,SRSS))
if SRSS=""!(SRSOUT)
QUIT
DO SPEC
+8 QUIT
PRINT IF 'CODE
SET SRCODE="ATTENDING/RES SUP CODE NOT ENTERED"
+1 IF CODE
SET Y=CODE
SET C=$PIECE(^DD(130,.166,0),"^",2)
DO Y^DIQ
SET SRCODE=Y
+2 WRITE !,?1,$JUSTIFY($SELECT(PRINT=1:^TMP("SRTC",$JOB,CODE),1:^TMP("SRTOT",$JOB,SRSS,CODE)),6),?16,SRCODE
+3 QUIT
HDR ; print heading
+1 IF +$Y
WRITE @IOF
+2 WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,?76,"PAGE",!,?32,"SURGICAL SERVICE",?78,SRPAGE,!,?22,"ATTENDING SURGEON CUMULATIVE REPORT"
+3 WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO
+4 IF $EXTRACT(IOST)="P"
WRITE !,?30,"DATE PRINTED: ",SRPRINT,!!,?8,"REVIEWED BY: ",?53,"DATE REVIEWED: "
+5 SET SRPAGE=SRPAGE+1
WRITE !
FOR LINE=1:1:80
WRITE "="
+6 QUIT
BREAK WRITE !!!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 IF X["?"
WRITE !!,"Enter RETURN if you want to display the totals for each specialty, or '^' to",!,"exit from this report."
GOTO BREAK
+2 QUIT
SPEC ; SPECIALTIES
+1 SET TOTAL=^TMP("SRTOT",$JOB,SRSS)
IF 'TOTAL
QUIT
+2 SET SRSSN=$SELECT($EXTRACT(SRSS,1,2)="ZZ":"SPECIALTY NOT ENTERED",1:SRSS)
+3 DO HDR
WRITE !!,?(80-$LENGTH(SRSSN)\2),SRSSN,!!,?1,"TOTAL CASES",?16,"ATTENDING/RES SUP CODE",!,?1,"-----------",?16,"--------------"
+4 SET CODE=""
FOR
SET CODE=$ORDER(^TMP("SRTOT",$JOB,SRSS,CODE))
if CODE=""
QUIT
DO PRINT
+5 WRITE !!,?1,$JUSTIFY(^TMP("SRTOT",$JOB,SRSS),6),?16,"TOTAL CASES FOR THIS SPECIALTY"
+6 IF $EXTRACT(IOST)'="P"
DO BREAK
IF SRSOUT
QUIT
+7 QUIT