VistA-WorldVistAEHR/r/SURGERY-SR/SROQM0.m

71 lines
4.2 KiB
Mathematica

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
SRSS 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="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