source: FOIAVistA/trunk/r/SURGERY-SR/SROQM0.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1SROQM0 ;B'HAM ISC/ADM - QUARTERLY REPORT (CONTINUED) ;07/18/07
2 ;;3.0; Surgery ;**38,62,50,95,129,163**;24 Jun 93;Build 2
3 ;** NOTICE: This routine is part of an implementation of a nationally
4 ;** controlled procedure. Local modifications to this routine
5 ;** are prohibited.
6 ;
7TOT D BLANK S SRBLANK="" F I=1:1:34 S SRBLANK=SRBLANK_" "
8 S SRLINE=SRBLANK_"Total Cases % of Total" D LINE
9 S SRLINE=SRBLANK_"----------- ----------" D LINE
10 S SRLINE=" Surgical Cases" F I=1:1:18 S SRLINE=SRLINE_" "
11 S SRBLANK="" F I=1:1:15 S SRBLANK=SRBLANK_" "
12SC S SRLINE=SRLINE_$J(SRCASES,6) S:SRCASES SRLINE=SRLINE_SRBLANK_"100.0" D LINE S SRALL=SRCASES I 'SRALL S SRALL=1
13 S SRLINE=" Major Procedures" F I=1:1:16 S SRLINE=SRLINE_" "
14MP S SRLINE=SRLINE_$J(SRMAJOR,6)_SRBLANK_$J(((SRMAJOR/SRALL)*100),5,1) S SRMAJ=SRMAJOR S:'SRMAJOR SRMAJ=1 D LINE
15ASA F I=1:1:6 S SRLINE=" ASA Class ("_I_") "_$J(SRASA(I),6)_SRBLANK_$J(((SRASA(I)/SRMAJ)*100),5,1) D LINE
16 I SRASA(7) S SRLINE=" ASA Class (Not Entered) "_$J(SRASA(7),6)_SRBLANK_$J(((SRASA(7)/SRMAJ)*100),5,1) D LINE
17POD S SRLINE=" Postoperative Deaths "_$J(SRMORT,6)_SRBLANK_$J(((SRMORT/SRALL)*100),5,1) D LINE
18 S SRLINE=" Ambulatory: "_SROPD D LINE
19POC S SRLINE=" Postoperative Occurrences "_$J(SRCOMP,6)_SRBLANK_$J(((SRCOMP/SRALL)*100),5,1) D LINE
20AP S SRLINE=" Ambulatory Procedures "_$J((SRCASES-SRINPAT),6)_SRBLANK_$J((((SRCASES-SRINPAT)/SRALL)*100),5,1) D LINE
21 S SRLINE=" Admitted Within 14 Days: "_SRADMT D LINE
22 S SRLINE=" Invasive Diagnostic: "_SRINV("O") D LINE
23IP S SRLINE=" Inpatient Procedures "_$J(SRINPAT,6)_SRBLANK_$J(((SRINPAT/SRALL)*100),5,1) D LINE
24EP S SRLINE=" Emergency Procedures "_$J(SREMERG,6)_SRBLANK_$J(((SREMERG/SRALL)*100),5,1) D LINE
25A60 S SRLINE=" Age>60 Years "_$J(SR60,6)_SRBLANK_$J(((SR60/SRALL)*100),5,1) D LINE
26SP D BLANK S SRBLANK="" F I=1:1:30 S SRBLANK=SRBLANK_" "
27 S SRLINE=SRBLANK_"SPECIALTY PROCEDURES" D LINE S SRLINE=SRBLANK_"--------------------" D LINE
28 S SRLINE=SRBLANK_SRBLANK_" ---DEATHS---" D LINE S SRBLANK="" F I=1:1:27 S SRBLANK=SRBLANK_" "
29 S SRLINE=SRBLANK_"PATIENTS CASES MAJOR MINOR TOTAL %" D LINE
30 S SRLINE=SRBLANK_"-------- ----- ----- ----- ----- ----" D LINE
31SRSS S SRPTF=48,SRSP="CARDIAC SURGERY" D SPOUT
32 S SRPTF=49,SRSP="TRANSPLANTATION" D SPOUT
33 S SRPTF=50,SRSP="GENERAL SURGERY" D SPOUT
34 S SRPTF=51,SRSP="OB/GYN" D SPOUT
35 S SRPTF=52,SRSP="NEUROSURGERY" D SPOUT
36 S SRPTF=53,SRSP="OPHTHALMOLOGY" D SPOUT
37 S SRPTF=54,SRSP="ORTHOPEDICS" D SPOUT
38 S SRPTF=55,SRSP="EAR, NOSE, THROAT (ENT)" D SPOUT
39 S SRPTF=56,SRSP="PLASTIC SURGERY" D SPOUT
40 S SRPTF=57,SRSP="PROCTOLOGY" D SPOUT
41 S SRPTF=58,SRSP="THORACIC SURGERY" D SPOUT
42 S SRPTF=59,SRSP="UROLOGY" D SPOUT
43 S SRPTF=60,SRSP="ORAL SURGERY" D SPOUT
44 S SRPTF=61,SRSP="PODIATRY" D SPOUT
45 S SRPTF=62,SRSP="PERIPHERAL VASCULAR" D SPOUT
46 S SRPTF=78,SRSP="ANESTHESIOLOGY" D SPOUT
47 I +^TMP("SRSS",$J,"ZZ") S SRPTF="ZZ",SRSP="NO SPECIALTY ENTERED" D SPOUT
48RES ; resident supervision
49 D BLANK S SRBLANK="" F I=1:1:23 S SRBLANK=SRBLANK_" "
50 S SRLINE=SRBLANK_"LEVEL OF RESIDENT SUPERVISION (%)" D LINE
51 S SRLINE=SRBLANK_"---------------------------------" D LINE
52 S SRLINE=SRBLANK_" MAJOR MINOR" D LINE
53 S SRIX=SRCASES-SRMAJOR,SRMAJ=SRMAJOR S:'SRIX SRIX=1 S:'SRMAJ SRMAJ=1
54 S I=0 F S I=$O(SRATT(I)) Q:'I D
55 .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")
56 .S SRL=SRL_" ",SRL=$E(SRL,1,12)
57 .S SRLINE=SRBLANK_"Level "_SRL_$J(((SRATT("J",I)/SRMAJ)*100),5,1)_" "_$J(((SRATT("N",I)/SRIX)*100),5,1) D LINE
58 F I=1:1 D BLANK Q:SRCNT>65
59 Q
60SPOUT ; get specialty data from ^TMP
61 F K=1:1:5 S SRP(K)=$P(^TMP("SRSS",$J,SRPTF),"^",K)
62 S:SRPTF="ZZ" SRPTF="" S SRLINE=$J(SRPTF,2)_" "_SRSP,SRBLANK="" F I=1:1:(27-$L(SRLINE)) S SRBLANK=SRBLANK_" "
63 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
64 Q
65BLANK ; blank line
66 S ^TMP("SRMSG",$J,SRCNT)="",SRCNT=SRCNT+1
67 Q
68LINE ; store line in ^TMP
69 S ^TMP("SRMSG",$J,SRCNT)=SRLINE,SRCNT=SRCNT+1
70 Q
Note: See TracBrowser for help on using the repository browser.