SROQ1 ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;07/18/07
;;3.0; Surgery ;**38,62,70,50,95,123,126,129,153,163**;24 Jun 93;Build 2
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
Q:SRSOUT U IO S (SRHDR,SRPAGE)=0 D HDR^SROQ0 Q:SRSOUT
TOT W !!,?35,"Total Cases",?55,"% of Total",!,?35,"-----------",?55,"----------"
W !,?5,"Surgical Cases",?37,$J(SRCASES,6) W:SRCASES ?57,"100.0" S SRALL=SRCASES I 'SRALL S SRALL=1
W !,?5,"Major Procedures",?37,$J(SRMAJOR,6),?57,$J(((SRMAJOR/SRALL)*100),5,1) S SRMAJ=SRMAJOR I 'SRMAJOR S SRMAJ=1
ASA F I=1:1:6 W !,?9,"ASA Class ("_I_")",?37,$J(SRASA(I),6),?57,$J(((SRASA(I)/SRMAJ)*100),5,1)
I SRASA(7) W !,?9,"ASA Class (Not Entered)",?37,$J(SRASA(7),6),?57,$J(((SRASA(7)/SRMAJ)*100),5,1)
W !,?5,"Postoperative Deaths",?37,$J(SRMORT,6),?57,$J(((SRMORT/SRALL)*100),5,1),!,?9,"Ambulatory: "_SROPD
W !,?5,"Postoperative Occurrences",?37,$J(SRCOMP,6),?57,$J(((SRCOMP/SRALL)*100),5,1)
W !,?5,"Ambulatory Procedures",?37,$J((SRCASES-SRINPAT),6),?57,$J((((SRCASES-SRINPAT)/SRALL)*100),5,1)
W !,?9,"Admitted Within 14 Days: "_SRADMT
W !,?9,"Invasive Diagnostic: "_SRINV("O")
W !,?5,"Inpatient Procedures",?37,$J(SRINPAT,6),?57,$J(((SRINPAT/SRALL)*100),5,1)
W !,?5,"Emergency Procedures",?37,$J(SREMERG,6),?57,$J(((SREMERG/SRALL)*100),5,1)
W !,?5,"Age>60 Years",?37,$J(SR60,6),?57,$J(((SR60/SRALL)*100),5,1)
SP D:$E(IOST,1,2)="C-" HDR^SROQ0 Q:SRSOUT W:$E(IOST,1,2)'="C-" !
W !!,?30,"SPECIALTY PROCEDURES",!,?30,"--------------------",!,?66,"---DEATHS---"
W !,?27,"PATIENTS CASES MAJOR MINOR TOTAL %"
W !,?27,"-------- ----- ----- ----- ----- ----"
S SRPTF=48,SRSP="CARDIAC SURGERY" D SPOUT
S SRPTF=49,SRSP="TRANSPLANTATION" D SPOUT
S SRPTF=50,SRSP="GENERAL SURGERY" D SPOUT
S SRPTF=51,SRSP="OB/GYN" D SPOUT
S SRPTF=52,SRSP="NEUROSURGERY" D SPOUT
S SRPTF=53,SRSP="OPHTHALMOLOGY" D SPOUT
S SRPTF=54,SRSP="ORTHOPEDICS" D SPOUT
S SRPTF=55,SRSP="EAR, NOSE, THROAT (ENT)" D SPOUT
S SRPTF=56,SRSP="PLASTIC SURGERY" D SPOUT
S SRPTF=57,SRSP="PROCTOLOGY" D SPOUT
S SRPTF=58,SRSP="THORACIC SURGERY" D SPOUT
S SRPTF=59,SRSP="UROLOGY" D SPOUT
S SRPTF=60,SRSP="ORAL SURGERY" D SPOUT
S SRPTF=61,SRSP="PODIATRY" D SPOUT
S SRPTF=62,SRSP="PERIPHERAL VASCULAR" D SPOUT
S SRPTF=78,SRSP="ANESTHESIOLOGY" D SPOUT
I +^TMP("SRSS",$J,"ZZ") S SRPTF="ZZ",SRSP="SPECIALTY NOT ENTERED" D SPOUT
RES ; resident supervision
I $E(IOST,1,2)="C-" D HDR^SROQ0 Q:SRSOUT
W !!!,?24,"LEVEL OF RESIDENT SUPERVISION (%)",!,?24,"---------------------------------",!,?42,"MAJOR MINOR"
S SRIX=SRCASES-SRMAJOR,SRMAJ=SRMAJOR S:'SRIX SRIX=1 S:'SRMAJ SRMAJ=1
S I=0 F S I=$O(SRATT("J",I)) Q:'I D
.S SRL=$S(I=9:"A",I=10:"B",I=11:"C",I=12:"D",I=13:"E",I=14:"F",I=1:"0 (Old)",I=2:"1 (Old)",I=3:"2 (Old)",I=4:"3 (Old)",I=5:"0",I=6:"1",I=7:"2",I=8:"3",1:"Not Entered")
.W !,?24,"Level ",SRL,?42,$J(((SRATT("J",I)/SRMAJ)*100),5,1),?52,$J(((SRATT("N",I)/SRIX)*100),5,1)
NDEX ; print data for index procedures
D HDR^SROQ0 Q:SRSOUT
W !!,?32,"INDEX PROCEDURES",!,?32,"----------------"
W !,?54,"CASES WITH",!,?30,"CASES DEATHS OCCURRENCES"
W !,?30,"----- ------- -----------"
F J=1:1:12 D IX
D ^SROQ1A
ENSURE ; ensuring correct surgery compliance
D HDR^SROQ0 Q:SRSOUT
W !!,?17,"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY",!,?17,"---------------------------------------------"
W !!,?42,"CASES % OF TOTAL",!,?42,"----- ----------"
W !,?18,"TOTAL CASES PERFORMED:"_$J(SRCASES,6) W:SRCASES ?53,"100.0"
W !!,?22,"TIME OUT VERIFIED",!,?36,"YES:"_$J(SRTOV,6) W:SRCASES ?53,$J(((SRTOV/SRCASES)*100),5,1)
W !,?37,"NO:"_$J(SRTONO,6) W:SRCASES ?53,$J(((SRTONO/SRCASES)*100),5,1)
W !,?28,"NOT ENTERED:"_$J(SRTONE,6) W:SRCASES ?53,$J(((SRTONE/SRCASES)*100),5,1)
W !!,?9,"PREOPERATIVE IMAGING CONFIRMED",!,?36,"YES:"_$J(SRICY,6) W:SRCASES ?53,$J(((SRICY/SRCASES)*100),5,1)
W !,?19,"IMAGING NOT REQUIRED:"_$J(SRICNR,6) W:SRCASES ?53,$J(((SRICNR/SRCASES)*100),5,1)
W !,?37,"NO:"_$J(SRICNO,6) W:SRCASES ?53,$J(((SRICNO/SRCASES)*100),5,1)
W !,?28,"NOT ENTERED:"_$J(SRICNE,6) W:SRCASES ?53,$J(((SRICNE/SRCASES)*100),5,1)
I $E(IOST,1,2)="C-" D HDR^SROQ0 Q:SRSOUT W !,?17,"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY (Continued)"
W !!,?8,"MARK ON SURGICAL SITE CONFIRMED",!,?36,"YES:"_$J(SRSCY,6) W:SRCASES ?53,$J(((SRSCY/SRCASES)*100),5,1)
W !,?19,"MARKING NOT REQUIRED:"_$J(SRSCNR,6) W:SRCASES ?53,$J(((SRSCNR/SRCASES)*100),5,1)
W !,?37,"NO:"_$J(SRSCNO,6) W:SRCASES ?53,$J(((SRSCNO/SRCASES)*100),5,1)
W !,?28,"NOT ENTERED:"_$J(SRSCNE,6) W:SRCASES ?53,$J(((SRSCNE/SRCASES)*100),5,1)
W !!,?20,"OVERALL COMPLIANCE FOR THIS DATE RANGE",!,?20,"--------------------------------------"
W !,?34,"TIME OUT VERIFIED: " W:SRCASES $J(((SRTOV/SRCASES)*100),5,1),"%"
W !,?21,"PREOPERATIVE IMAGING CONFIRMED: " W:SRCASES $J((((SRICY+SRICNR)/SRCASES)*100),5,1),"%"
W !,?20,"MARK ON SURGICAL SITE CONFIRMED: " W:SRCASES $J((((SRSCY+SRSCNR)/SRCASES)*100),5,1),"%"
HAIR ; print hair removal methods
D:$E(IOST,1,2)="C-" HDR^SROQ0 Q:SRSOUT W:$E(IOST,1,2)'="C-" !
W !!,?19,"PREOPERATIVE HAIR REMOVAL METHODS SUMMARY",!,?19,"-----------------------------------------"
W !!,?42,"CASES % OF TOTAL",!,?42,"----- ----------"
W !,?18,"TOTAL CASES PERFORMED:"_$J(SRCASES,6) W:SRCASES ?53,"100.0"
W !!,?32,"CLIPPER:"_$J(SRHAIR("C"),6) W:SRCASES ?53,$J(((SRHAIR("C")/SRCASES)*100),5,1)
W !,?29,"DEPILATORY:"_$J(SRHAIR("D"),6) W:SRCASES ?53,$J(((SRHAIR("D")/SRCASES)*100),5,1)
W !,?24,"NO HAIR REMOVED:"_$J(SRHAIR("N"),6) W:SRCASES ?53,$J(((SRHAIR("N")/SRCASES)*100),5,1)
W !,?15,"PATIENT REMOVED OWN HAIR:"_$J(SRHAIR("P"),6) W:SRCASES ?53,$J(((SRHAIR("P")/SRCASES)*100),5,1)
W !,?32,"SHAVING:"_$J(SRHAIR("S"),6) W:SRCASES ?53,$J(((SRHAIR("S")/SRCASES)*100),5,1)
N SRNDOC S SRNDOC=SRHAIR("U")+SRHAIR("ZZ")
W !,?25,"NOT DOCUMENTED:"_$J(SRNDOC,6) W:SRCASES ?53,$J(((SRNDOC/SRCASES)*100),5,1)
W !,?34,"OTHER:"_$J(SRHAIR("O"),6) W:SRCASES ?53,$J(((SRHAIR("O")/SRCASES)*100),5,1)
Q
IX ; break out index procedure data from ^TMP
F K=1:1:3 S SRP(K)=$P(^TMP("SRPROC",$J,J),"^",K)
D IXOUT^SROQ0A D
.I SROP["," W:J=7 !,?5,$P(SROP,",") S SROP=$P(SROP,",",2)
.W !,?5,SROP,?29,$J(SRP(1),6),?42,$J(SRP(3),6),?55,$J(SRP(2),6)
Q
SPOUT ; break out data for each specialty from ^TMP
F K=1:1:5 S SRP(K)=$P(^TMP("SRSS",$J,SRPTF),"^",K)
I SRPTF="ZZ" S SRPTF=""
W !,$J(SRPTF,2),?4,SRSP,?27,$J(SRP(1),6),?37,$J(SRP(2),6),?46,$J(SRP(3),6),?55,$J(SRP(4),6),?64,$J(SRP(5),6),?73,$J(((SRP(5)/$S(SRP(2):SRP(2),1:1))*100),5,1)
Q
SROQ1 ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;07/18/07
+1 ;;3.0; Surgery ;**38,62,70,50,95,123,126,129,153,163**;24 Jun 93;Build 2
+2 ;** NOTICE: This routine is part of an implementation of a nationally
+3 ;** controlled procedure. Local modifications to this routine
+4 ;** are prohibited.
+5 ;
+6 IF SRSOUT
QUIT
USE IO
SET (SRHDR,SRPAGE)=0
DO HDR^SROQ0
IF SRSOUT
QUIT
TOT WRITE !!,?35,"Total Cases",?55,"% of Total",!,?35,"-----------",?55,"----------"
+1 WRITE !,?5,"Surgical Cases",?37,$JUSTIFY(SRCASES,6)
IF SRCASES
WRITE ?57,"100.0"
SET SRALL=SRCASES
IF 'SRALL
SET SRALL=1
+2 WRITE !,?5,"Major Procedures",?37,$JUSTIFY(SRMAJOR,6),?57,$JUSTIFY(((SRMAJOR/SRALL)*100),5,1)
SET SRMAJ=SRMAJOR
IF 'SRMAJOR
SET SRMAJ=1
ASA FOR I=1:1:6
WRITE !,?9,"ASA Class ("_I_")",?37,$JUSTIFY(SRASA(I),6),?57,$JUSTIFY(((SRASA(I)/SRMAJ)*100),5,1)
+1 IF SRASA(7)
WRITE !,?9,"ASA Class (Not Entered)",?37,$JUSTIFY(SRASA(7),6),?57,$JUSTIFY(((SRASA(7)/SRMAJ)*100),5,1)
+2 WRITE !,?5,"Postoperative Deaths",?37,$JUSTIFY(SRMORT,6),?57,$JUSTIFY(((SRMORT/SRALL)*100),5,1),!,?9,"Ambulatory: "_SROPD
+3 WRITE !,?5,"Postoperative Occurrences",?37,$JUSTIFY(SRCOMP,6),?57,$JUSTIFY(((SRCOMP/SRALL)*100),5,1)
+4 WRITE !,?5,"Ambulatory Procedures",?37,$JUSTIFY((SRCASES-SRINPAT),6),?57,$JUSTIFY((((SRCASES-SRINPAT)/SRALL)*100),5,1)
+5 WRITE !,?9,"Admitted Within 14 Days: "_SRADMT
+6 WRITE !,?9,"Invasive Diagnostic: "_SRINV("O")
+7 WRITE !,?5,"Inpatient Procedures",?37,$JUSTIFY(SRINPAT,6),?57,$JUSTIFY(((SRINPAT/SRALL)*100),5,1)
+8 WRITE !,?5,"Emergency Procedures",?37,$JUSTIFY(SREMERG,6),?57,$JUSTIFY(((SREMERG/SRALL)*100),5,1)
+9 WRITE !,?5,"Age>60 Years",?37,$JUSTIFY(SR60,6),?57,$JUSTIFY(((SR60/SRALL)*100),5,1)
SP IF $EXTRACT(IOST,1,2)="C-"
DO HDR^SROQ0
IF SRSOUT
QUIT
IF $EXTRACT(IOST,1,2)'="C-"
WRITE !
+1 WRITE !!,?30,"SPECIALTY PROCEDURES",!,?30,"--------------------",!,?66,"---DEATHS---"
+2 WRITE !,?27,"PATIENTS CASES MAJOR MINOR TOTAL %"
+3 WRITE !,?27,"-------- ----- ----- ----- ----- ----"
+1 SET SRPTF=48
SET SRSP="CARDIAC SURGERY"
DO SPOUT
+2 SET SRPTF=49
SET SRSP="TRANSPLANTATION"
DO SPOUT
+3 SET SRPTF=50
SET SRSP="GENERAL SURGERY"
DO SPOUT
+4 SET SRPTF=51
SET SRSP="OB/GYN"
DO SPOUT
+5 SET SRPTF=52
SET SRSP="NEUROSURGERY"
DO SPOUT
+6 SET SRPTF=53
SET SRSP="OPHTHALMOLOGY"
DO SPOUT
+7 SET SRPTF=54
SET SRSP="ORTHOPEDICS"
DO SPOUT
+8 SET SRPTF=55
SET SRSP="EAR, NOSE, THROAT (ENT)"
DO SPOUT
+9 SET SRPTF=56
SET SRSP="PLASTIC SURGERY"
DO SPOUT
+10 SET SRPTF=57
SET SRSP="PROCTOLOGY"
DO SPOUT
+11 SET SRPTF=58
SET SRSP="THORACIC SURGERY"
DO SPOUT
+12 SET SRPTF=59
SET SRSP="UROLOGY"
DO SPOUT
+13 SET SRPTF=60
SET SRSP="ORAL SURGERY"
DO SPOUT
+14 SET SRPTF=61
SET SRSP="PODIATRY"
DO SPOUT
+15 SET SRPTF=62
SET SRSP="PERIPHERAL VASCULAR"
DO SPOUT
+16 SET SRPTF=78
SET SRSP="ANESTHESIOLOGY"
DO SPOUT
+17 IF +^TMP("SRSS",$JOB,"ZZ")
SET SRPTF="ZZ"
SET SRSP="SPECIALTY NOT ENTERED"
DO SPOUT
RES ; resident supervision
+1 IF $EXTRACT(IOST,1,2)="C-"
DO HDR^SROQ0
IF SRSOUT
QUIT
+2 WRITE !!!,?24,"LEVEL OF RESIDENT SUPERVISION (%)",!,?24,"---------------------------------",!,?42,"MAJOR MINOR"
+3 SET SRIX=SRCASES-SRMAJOR
SET SRMAJ=SRMAJOR
IF 'SRIX
SET SRIX=1
IF 'SRMAJ
SET SRMAJ=1
+4 SET I=0
FOR
SET I=$ORDER(SRATT("J",I))
IF 'I
QUIT
Begin DoDot:1
+5 SET SRL=$SELECT(I=9:"A",I=10:"B",I=11:"C",I=12:"D",I=13:"E",I=14:"F",I=1:"0 (Old)",I=2:"1 (Old)",I=3:"2 (Old)",I=4:"3 (Old)",I=5:"0",I=6:"1",I=7:"2",I=8:"3",1:"Not Entered")
+6 WRITE !,?24,"Level ",SRL,?42,$JUSTIFY(((SRATT("J",I)/SRMAJ)*100),5,1),?52,$JUSTIFY(((SRATT("N",I)/SRIX)*100),5,1)
End DoDot:1
NDEX ; print data for index procedures
+1 DO HDR^SROQ0
IF SRSOUT
QUIT
+2 WRITE !!,?32,"INDEX PROCEDURES",!,?32,"----------------"
+3 WRITE !,?54,"CASES WITH",!,?30,"CASES DEATHS OCCURRENCES"
+4 WRITE !,?30,"----- ------- -----------"
+5 FOR J=1:1:12
DO IX
+6 DO ^SROQ1A
ENSURE ; ensuring correct surgery compliance
+1 DO HDR^SROQ0
IF SRSOUT
QUIT
+2 WRITE !!,?17,"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY",!,?17,"---------------------------------------------"
+3 WRITE !!,?42,"CASES % OF TOTAL",!,?42,"----- ----------"
+4 WRITE !,?18,"TOTAL CASES PERFORMED:"_$JUSTIFY(SRCASES,6)
IF SRCASES
WRITE ?53,"100.0"
+5 WRITE !!,?22,"TIME OUT VERIFIED",!,?36,"YES:"_$JUSTIFY(SRTOV,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRTOV/SRCASES)*100),5,1)
+6 WRITE !,?37,"NO:"_$JUSTIFY(SRTONO,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRTONO/SRCASES)*100),5,1)
+7 WRITE !,?28,"NOT ENTERED:"_$JUSTIFY(SRTONE,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRTONE/SRCASES)*100),5,1)
+8 WRITE !!,?9,"PREOPERATIVE IMAGING CONFIRMED",!,?36,"YES:"_$JUSTIFY(SRICY,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRICY/SRCASES)*100),5,1)
+9 WRITE !,?19,"IMAGING NOT REQUIRED:"_$JUSTIFY(SRICNR,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRICNR/SRCASES)*100),5,1)
+10 WRITE !,?37,"NO:"_$JUSTIFY(SRICNO,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRICNO/SRCASES)*100),5,1)
+11 WRITE !,?28,"NOT ENTERED:"_$JUSTIFY(SRICNE,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRICNE/SRCASES)*100),5,1)
+12 IF $EXTRACT(IOST,1,2)="C-"
DO HDR^SROQ0
IF SRSOUT
QUIT
WRITE !,?17,"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY (Continued)"
+13 WRITE !!,?8,"MARK ON SURGICAL SITE CONFIRMED",!,?36,"YES:"_$JUSTIFY(SRSCY,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRSCY/SRCASES)*100),5,1)
+14 WRITE !,?19,"MARKING NOT REQUIRED:"_$JUSTIFY(SRSCNR,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRSCNR/SRCASES)*100),5,1)
+15 WRITE !,?37,"NO:"_$JUSTIFY(SRSCNO,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRSCNO/SRCASES)*100),5,1)
+16 WRITE !,?28,"NOT ENTERED:"_$JUSTIFY(SRSCNE,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRSCNE/SRCASES)*100),5,1)
+17 WRITE !!,?20,"OVERALL COMPLIANCE FOR THIS DATE RANGE",!,?20,"--------------------------------------"
+18 WRITE !,?34,"TIME OUT VERIFIED: "
IF SRCASES
WRITE $JUSTIFY(((SRTOV/SRCASES)*100),5,1),"%"
+19 WRITE !,?21,"PREOPERATIVE IMAGING CONFIRMED: "
IF SRCASES
WRITE $JUSTIFY((((SRICY+SRICNR)/SRCASES)*100),5,1),"%"
+20 WRITE !,?20,"MARK ON SURGICAL SITE CONFIRMED: "
IF SRCASES
WRITE $JUSTIFY((((SRSCY+SRSCNR)/SRCASES)*100),5,1),"%"
HAIR ; print hair removal methods
+1 IF $EXTRACT(IOST,1,2)="C-"
DO HDR^SROQ0
IF SRSOUT
QUIT
IF $EXTRACT(IOST,1,2)'="C-"
WRITE !
+2 WRITE !!,?19,"PREOPERATIVE HAIR REMOVAL METHODS SUMMARY",!,?19,"-----------------------------------------"
+3 WRITE !!,?42,"CASES % OF TOTAL",!,?42,"----- ----------"
+4 WRITE !,?18,"TOTAL CASES PERFORMED:"_$JUSTIFY(SRCASES,6)
IF SRCASES
WRITE ?53,"100.0"
+5 WRITE !!,?32,"CLIPPER:"_$JUSTIFY(SRHAIR("C"),6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRHAIR("C")/SRCASES)*100),5,1)
+6 WRITE !,?29,"DEPILATORY:"_$JUSTIFY(SRHAIR("D"),6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRHAIR("D")/SRCASES)*100),5,1)
+7 WRITE !,?24,"NO HAIR REMOVED:"_$JUSTIFY(SRHAIR("N"),6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRHAIR("N")/SRCASES)*100),5,1)
+8 WRITE !,?15,"PATIENT REMOVED OWN HAIR:"_$JUSTIFY(SRHAIR("P"),6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRHAIR("P")/SRCASES)*100),5,1)
+9 WRITE !,?32,"SHAVING:"_$JUSTIFY(SRHAIR("S"),6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRHAIR("S")/SRCASES)*100),5,1)
+10 NEW SRNDOC
SET SRNDOC=SRHAIR("U")+SRHAIR("ZZ")
+11 WRITE !,?25,"NOT DOCUMENTED:"_$JUSTIFY(SRNDOC,6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRNDOC/SRCASES)*100),5,1)
+12 WRITE !,?34,"OTHER:"_$JUSTIFY(SRHAIR("O"),6)
IF SRCASES
WRITE ?53,$JUSTIFY(((SRHAIR("O")/SRCASES)*100),5,1)
+13 QUIT
IX ; break out index procedure data from ^TMP
+1 FOR K=1:1:3
SET SRP(K)=$PIECE(^TMP("SRPROC",$JOB,J),"^",K)
+2 DO IXOUT^SROQ0A
Begin DoDot:1
+3 IF SROP[","
IF J=7
WRITE !,?5,$PIECE(SROP,",")
SET SROP=$PIECE(SROP,",",2)
+4 WRITE !,?5,SROP,?29,$JUSTIFY(SRP(1),6),?42,$JUSTIFY(SRP(3),6),?55,$JUSTIFY(SRP(2),6)
End DoDot:1
+5 QUIT
SPOUT ; break out data for each specialty from ^TMP
+1 FOR K=1:1:5
SET SRP(K)=$PIECE(^TMP("SRSS",$JOB,SRPTF),"^",K)
+2 IF SRPTF="ZZ"
SET SRPTF=""
+3 WRITE !,$JUSTIFY(SRPTF,2),?4,SRSP,?27,$JUSTIFY(SRP(1),6),?37,$JUSTIFY(SRP(2),6),?46,$JUSTIFY(SRP(3),6),?55,$JUSTIFY(SRP(4),6),?64,$JUSTIFY(SRP(5),6),?73,$JUSTIFY(((SRP(5)/$SELECT(SRP(2):SRP(2),1:1))*100),5,1)
+4 QUIT
