SROQM0 ;B'HAM ISC/ADM - QUARTERLY REPORT (CONTINUED) ;07/18/07
;;3.0; Surgery ;**38,62,50,95,129,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.
;
TOT D BLANK S SRBLANK="" F I=1:1:34 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"Total Cases % of Total" D LINE
S SRLINE=SRBLANK_"----------- ----------" D LINE
S SRLINE=" Surgical Cases" F I=1:1:18 S SRLINE=SRLINE_" "
S SRBLANK="" F I=1:1:15 S SRBLANK=SRBLANK_" "
SC S SRLINE=SRLINE_$J(SRCASES,6) S:SRCASES SRLINE=SRLINE_SRBLANK_"100.0" D LINE S SRALL=SRCASES I 'SRALL S SRALL=1
S SRLINE=" Major Procedures" F I=1:1:16 S SRLINE=SRLINE_" "
MP S SRLINE=SRLINE_$J(SRMAJOR,6)_SRBLANK_$J(((SRMAJOR/SRALL)*100),5,1) S SRMAJ=SRMAJOR S:'SRMAJOR SRMAJ=1 D LINE
ASA F I=1:1:6 S SRLINE=" ASA Class ("_I_") "_$J(SRASA(I),6)_SRBLANK_$J(((SRASA(I)/SRMAJ)*100),5,1) D LINE
I SRASA(7) S SRLINE=" ASA Class (Not Entered) "_$J(SRASA(7),6)_SRBLANK_$J(((SRASA(7)/SRMAJ)*100),5,1) D LINE
POD S SRLINE=" Postoperative Deaths "_$J(SRMORT,6)_SRBLANK_$J(((SRMORT/SRALL)*100),5,1) D LINE
S SRLINE=" Ambulatory: "_SROPD D LINE
POC S SRLINE=" Postoperative Occurrences "_$J(SRCOMP,6)_SRBLANK_$J(((SRCOMP/SRALL)*100),5,1) D LINE
AP S SRLINE=" Ambulatory Procedures "_$J((SRCASES-SRINPAT),6)_SRBLANK_$J((((SRCASES-SRINPAT)/SRALL)*100),5,1) D LINE
S SRLINE=" Admitted Within 14 Days: "_SRADMT D LINE
S SRLINE=" Invasive Diagnostic: "_SRINV("O") D LINE
IP S SRLINE=" Inpatient Procedures "_$J(SRINPAT,6)_SRBLANK_$J(((SRINPAT/SRALL)*100),5,1) D LINE
EP S SRLINE=" Emergency Procedures "_$J(SREMERG,6)_SRBLANK_$J(((SREMERG/SRALL)*100),5,1) D LINE
A60 S SRLINE=" Age>60 Years "_$J(SR60,6)_SRBLANK_$J(((SR60/SRALL)*100),5,1) D LINE
SP D BLANK S SRBLANK="" F I=1:1:30 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"SPECIALTY PROCEDURES" D LINE S SRLINE=SRBLANK_"--------------------" D LINE
S SRLINE=SRBLANK_SRBLANK_" ---DEATHS---" D LINE S SRBLANK="" F I=1:1:27 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"PATIENTS CASES MAJOR MINOR TOTAL %" D LINE
S SRLINE=SRBLANK_"-------- ----- ----- ----- ----- ----" D LINE
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="NO SPECIALTY ENTERED" D SPOUT
RES ; resident supervision
D BLANK S SRBLANK="" F I=1:1:23 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"LEVEL OF RESIDENT SUPERVISION (%)" D LINE
S SRLINE=SRBLANK_"---------------------------------" D LINE
S SRLINE=SRBLANK_" MAJOR MINOR" D LINE
S SRIX=SRCASES-SRMAJOR,SRMAJ=SRMAJOR S:'SRIX SRIX=1 S:'SRMAJ SRMAJ=1
S I=0 F S I=$O(SRATT(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")
.S SRL=SRL_" ",SRL=$E(SRL,1,12)
.S SRLINE=SRBLANK_"Level "_SRL_$J(((SRATT("J",I)/SRMAJ)*100),5,1)_" "_$J(((SRATT("N",I)/SRIX)*100),5,1) D LINE
F I=1:1 D BLANK Q:SRCNT>65
Q
SPOUT ; get specialty data from ^TMP
F K=1:1:5 S SRP(K)=$P(^TMP("SRSS",$J,SRPTF),"^",K)
S:SRPTF="ZZ" SRPTF="" S SRLINE=$J(SRPTF,2)_" "_SRSP,SRBLANK="" F I=1:1:(27-$L(SRLINE)) S SRBLANK=SRBLANK_" "
S SRLINE=SRLINE_SRBLANK_$J(SRP(1),6)_" "_$J(SRP(2),6)_" "_$J(SRP(3),6)_" "_$J(SRP(4),6)_" "_$J(SRP(5),6)_" "_$J(((SRP(5)/$S(SRP(2):SRP(2),1:1))*100),5,1) D LINE
Q
BLANK ; blank line
S ^TMP("SRMSG",$J,SRCNT)="",SRCNT=SRCNT+1
Q
LINE ; store line in ^TMP
S ^TMP("SRMSG",$J,SRCNT)=SRLINE,SRCNT=SRCNT+1
Q
SROQM0 ;B'HAM ISC/ADM - QUARTERLY REPORT (CONTINUED) ;07/18/07
+1 ;;3.0; Surgery ;**38,62,50,95,129,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 ;
TOT DO BLANK
SET SRBLANK=""
FOR I=1:1:34
SET SRBLANK=SRBLANK_" "
+1 SET SRLINE=SRBLANK_"Total Cases % of Total"
DO LINE
+2 SET SRLINE=SRBLANK_"----------- ----------"
DO LINE
+3 SET SRLINE=" Surgical Cases"
FOR I=1:1:18
SET SRLINE=SRLINE_" "
+4 SET SRBLANK=""
FOR I=1:1:15
SET SRBLANK=SRBLANK_" "
SC SET SRLINE=SRLINE_$JUSTIFY(SRCASES,6)
IF SRCASES
SET SRLINE=SRLINE_SRBLANK_"100.0"
DO LINE
SET SRALL=SRCASES
IF 'SRALL
SET SRALL=1
+1 SET SRLINE=" Major Procedures"
FOR I=1:1:16
SET SRLINE=SRLINE_" "
MP SET SRLINE=SRLINE_$JUSTIFY(SRMAJOR,6)_SRBLANK_$JUSTIFY(((SRMAJOR/SRALL)*100),5,1)
SET SRMAJ=SRMAJOR
IF 'SRMAJOR
SET SRMAJ=1
DO LINE
ASA FOR I=1:1:6
SET SRLINE=" ASA Class ("_I_") "_$JUSTIFY(SRASA(I),6)_SRBLANK_$JUSTIFY(((SRASA(I)/SRMAJ)*100),5,1)
DO LINE
+1 IF SRASA(7)
SET SRLINE=" ASA Class (Not Entered) "_$JUSTIFY(SRASA(7),6)_SRBLANK_$JUSTIFY(((SRASA(7)/SRMAJ)*100),5,1)
DO LINE
POD SET SRLINE=" Postoperative Deaths "_$JUSTIFY(SRMORT,6)_SRBLANK_$JUSTIFY(((SRMORT/SRALL)*100),5,1)
DO LINE
+1 SET SRLINE=" Ambulatory: "_SROPD
DO LINE
POC SET SRLINE=" Postoperative Occurrences "_$JUSTIFY(SRCOMP,6)_SRBLANK_$JUSTIFY(((SRCOMP/SRALL)*100),5,1)
DO LINE
AP SET SRLINE=" Ambulatory Procedures "_$JUSTIFY((SRCASES-SRINPAT),6)_SRBLANK_$JUSTIFY((((SRCASES-SRINPAT)/SRALL)*100),5,1)
DO LINE
+1 SET SRLINE=" Admitted Within 14 Days: "_SRADMT
DO LINE
+2 SET SRLINE=" Invasive Diagnostic: "_SRINV("O")
DO LINE
IP SET SRLINE=" Inpatient Procedures "_$JUSTIFY(SRINPAT,6)_SRBLANK_$JUSTIFY(((SRINPAT/SRALL)*100),5,1)
DO LINE
EP SET SRLINE=" Emergency Procedures "_$JUSTIFY(SREMERG,6)_SRBLANK_$JUSTIFY(((SREMERG/SRALL)*100),5,1)
DO LINE
A60 SET SRLINE=" Age>60 Years "_$JUSTIFY(SR60,6)_SRBLANK_$JUSTIFY(((SR60/SRALL)*100),5,1)
DO LINE
SP DO BLANK
SET SRBLANK=""
FOR I=1:1:30
SET SRBLANK=SRBLANK_" "
+1 SET SRLINE=SRBLANK_"SPECIALTY PROCEDURES"
DO LINE
SET SRLINE=SRBLANK_"--------------------"
DO LINE
+2 SET SRLINE=SRBLANK_SRBLANK_" ---DEATHS---"
DO LINE
SET SRBLANK=""
FOR I=1:1:27
SET SRBLANK=SRBLANK_" "
+3 SET SRLINE=SRBLANK_"PATIENTS CASES MAJOR MINOR TOTAL %"
DO LINE
+4 SET SRLINE=SRBLANK_"-------- ----- ----- ----- ----- ----"
DO LINE
SET SRSP="CARDIAC SURGERY"
DO SPOUT
+1 SET SRPTF=49
SET SRSP="TRANSPLANTATION"
DO SPOUT
+2 SET SRPTF=50
SET SRSP="GENERAL SURGERY"
DO SPOUT
+3 SET SRPTF=51
SET SRSP="OB/GYN"
DO SPOUT
+4 SET SRPTF=52
SET SRSP="NEUROSURGERY"
DO SPOUT
+5 SET SRPTF=53
SET SRSP="OPHTHALMOLOGY"
DO SPOUT
+6 SET SRPTF=54
SET SRSP="ORTHOPEDICS"
DO SPOUT
+7 SET SRPTF=55
SET SRSP="EAR, NOSE, THROAT (ENT)"
DO SPOUT
+8 SET SRPTF=56
SET SRSP="PLASTIC SURGERY"
DO SPOUT
+9 SET SRPTF=57
SET SRSP="PROCTOLOGY"
DO SPOUT
+10 SET SRPTF=58
SET SRSP="THORACIC SURGERY"
DO SPOUT
+11 SET SRPTF=59
SET SRSP="UROLOGY"
DO SPOUT
+12 SET SRPTF=60
SET SRSP="ORAL SURGERY"
DO SPOUT
+13 SET SRPTF=61
SET SRSP="PODIATRY"
DO SPOUT
+14 SET SRPTF=62
SET SRSP="PERIPHERAL VASCULAR"
DO SPOUT
+15 SET SRPTF=78
SET SRSP="ANESTHESIOLOGY"
DO SPOUT
+16 IF +^TMP("SRSS",$JOB,"ZZ")
SET SRPTF="ZZ"
SET SRSP="NO SPECIALTY ENTERED"
DO SPOUT
RES ; resident supervision
+1 DO BLANK
SET SRBLANK=""
FOR I=1:1:23
SET SRBLANK=SRBLANK_" "
+2 SET SRLINE=SRBLANK_"LEVEL OF RESIDENT SUPERVISION (%)"
DO LINE
+3 SET SRLINE=SRBLANK_"---------------------------------"
DO LINE
+4 SET SRLINE=SRBLANK_" MAJOR MINOR"
DO LINE
+5 SET SRIX=SRCASES-SRMAJOR
SET SRMAJ=SRMAJOR
IF 'SRIX
SET SRIX=1
IF 'SRMAJ
SET SRMAJ=1
+6 SET I=0
FOR
SET I=$ORDER(SRATT(I))
IF 'I
QUIT
Begin DoDot:1
+7 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")
+8 SET SRL=SRL_" "
SET SRL=$EXTRACT(SRL,1,12)
+9 SET SRLINE=SRBLANK_"Level "_SRL_$JUSTIFY(((SRATT("J",I)/SRMAJ)*100),5,1)_" "_$JUSTIFY(((SRATT("N",I)/SRIX)*100),5,1)
DO LINE
End DoDot:1
+10 FOR I=1:1
DO BLANK
IF SRCNT>65
QUIT
+11 QUIT
SPOUT ; get specialty data from ^TMP
+1 FOR K=1:1:5
SET SRP(K)=$PIECE(^TMP("SRSS",$JOB,SRPTF),"^",K)
+2 IF SRPTF="ZZ"
SET SRPTF=""
SET SRLINE=$JUSTIFY(SRPTF,2)_" "_SRSP
SET SRBLANK=""
FOR I=1:1:(27-$LENGTH(SRLINE))
SET SRBLANK=SRBLANK_" "
+3 SET SRLINE=SRLINE_SRBLANK_$JUSTIFY(SRP(1),6)_" "_$JUSTIFY(SRP(2),6)_" "_$JUSTIFY(SRP(3),6)_" "_$JUSTIFY(SRP(4),6)_" "_$JUSTIFY(SRP(5),6)_" "_$JUSTIFY(((SRP(5)/$SELECT(SRP(2):SRP(2),1:1))*100),5,1)
DO LINE
+4 QUIT
BLANK ; blank line
+1 SET ^TMP("SRMSG",$JOB,SRCNT)=""
SET SRCNT=SRCNT+1
+2 QUIT
LINE ; store line in ^TMP
+1 SET ^TMP("SRMSG",$JOB,SRCNT)=SRLINE
SET SRCNT=SRCNT+1
+2 QUIT
