source: FOIAVistA/trunk/r/SURGERY-SR/SROQM1.m@ 868

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1SROQM1 ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;01/30/07
2 ;;3.0; Surgery ;**38,62,70,129,153,160**;24 Jun 93;Build 7
3 ;** NOTICE: This routine is part of an implementation of a nationally
4 ;** controlled procedure. Local modifications to this routine
5 ;** are prohibited.
6 ;
7NDEX ; index procedures
8 D BLANK S SRBLANK="" F I=1:1:31 S SRBLANK=SRBLANK_" "
9 S SRLINE=SRBLANK_"INDEX PROCEDURES" D LINE S SRLINE=SRBLANK_"----------------" D LINE
10 F I=1:1:22 S SRBLANK=SRBLANK_" "
11 S SRLINE=SRBLANK_"CASES WITH" D LINE S SRBLANK="" F I=1:1:29 S SRBLANK=SRBLANK_" "
12 S SRLINE=SRBLANK_"CASES DEATHS OCCURRENCES" D LINE
13 S SRLINE=SRBLANK_"----- ------ -----------" D LINE
14 F J=1:1:12 D IXUT
15CC ; occurrence categories
16 D BLANK S SRBLANK="" F I=1:1:21 S SRBLANK=SRBLANK_" "
17 S SRLINE=SRBLANK_"PERIOPERATIVE OCCURRENCE CATEGORIES" D LINE S SRLINE=SRBLANK_"-----------------------------------" D LINE
18WC D BLANK S SRLINE=" Wound Occurrences Total Urinary Occurrences Total" D LINE
19 S SRLINE=" A. Superficial Incisional SSI"_$J(SRC(1),5)_" A. Renal Insufficiency "_$J(SRC(8),5) D LINE
20 S SRLINE=" B. Deep Incisional SSI "_$J(SRC(2),5)_" B. Acute Renal Failure "_$J(SRC(9),5) D LINE
21 S SRLINE=" C. Wound Disruption "_$J(SRC(22),5)_" C. Urinary Tract Infection "_$J(SRC(10),5) D LINE
22 S SRLINE=" D. Other "_$J(SRC(36),5)_" D. Other "_$J(SRC(31),5) D LINE,BLANK
23RC S SRLINE=" Respiratory Occurrences Total CNS Occurrences Total" D LINE
24 S SRLINE=" A. Pneumonia "_$J(SRC(4),5)_" A. CVA/Stroke "_$J((SRC(12)+SRC(28)),5) D LINE
25 S SRLINE=" B. Unplanned Intubation "_$J((SRC(7)+SRC(11)),5)_" B. Coma >24 Hours "_$J(SRC(13),5) D LINE
26 S SRLINE=" C. Pulmonary Embolism "_$J(SRC(5),5)_" C. Peripheral Nerve Injury "_$J(SRC(14),5) D LINE
27 S SRLINE=" D. On Ventilator >48 Hours "_$J(SRC(6),5)_" D. Other "_$J(SRC(30),5) D LINE
28 S SRLINE=" E. Tracheostomy "_$J(SRC(33),5) D LINE
29 S SRLINE=" F. Repeat Vent w/in 30 Days "_$J(SRC(37),5) D LINE
30 S SRLINE=" G. Other "_$J(SRC(29),5) D LINE
31 S SRBLANK="" F I=1:1:41 S SRBLANK=SRBLANK_" "
32 S SRLINE=SRBLANK_"Other Occurrences Total" D LINE
33CARD S SRLINE=" Cardiac Occurrences Total A. Organ/Space SSI "_$J(SRC(35),5) D LINE
34 S SRLINE=" A. Cardiac Arrest Req. CPR "_$J(SRC(16),5)_" B. Bleeding/Transfusions "_$J(SRC(15),5) D LINE
35 S SRLINE=" B. Myocardial Infarction "_$J(SRC(17),5)_" C. Graft/Prosthesis/Flap" D LINE
36 S SRLINE=" C. Endocarditis "_$J(SRC(23),5)_" Failure "_$J(SRC(19),5) D LINE
37 S SRLINE=" D. Low Cardiac Output >6 Hrs."_$J(SRC(24),5)_" D. DVT/Thrombophlebitis "_$J(SRC(20),5) D LINE
38 S SRLINE=" E. Mediastinitis "_$J(SRC(25),5)_" E. Systemic Sepsis "_$J(SRC(3),5) D LINE
39 S SRLINE=" F. Repeat Card Surg Proc "_$J(SRC(27),5)_" F. Reoperation for Bleeding "_$J(SRC(26),5) D LINE
40 S SRLINE=" G. New Mech Circulatory Sup "_$J(SRC(34),5)_" G. C. difficile Colitis "_$J(SRC(38),5) D LINE
41 S SRLINE=" H. Other "_$J(SRC(32),5)_" H. Other "_$J(SRC(21),5) D LINE,BLANK
42 S:'SRWC SRWC=1 S SRLINE=" Clean Wound Infection Rate: "_$J((SRIN/SRWC*100),5,1)_"%" D LINE
43 Q
44IXUT ; get index procedure data from ^TMP
45 F K=1:1:3 S SRP(K)=$P(^TMP("SRPROC",$J,J),"^",K)
46 D IXOUT^SROQ0A D
47 .I SROP["," D S SROP=$P(SROP,",",2)
48 ..I J=7 S SRLINE=" "_$P(SROP,",") D LINE
49 .S SRLINE=" "_SROP S SRBLANK="" F I=1:1:(28-$L(SRLINE)) S SRBLANK=SRBLANK_" "
50 S SRLINE=SRLINE_SRBLANK_$J(SRP(1),6)_" "_$J(SRP(3),6)_" "_$J(SRP(2),6) D LINE
51 Q
52BLANK ; blank line
53 S ^TMP("SRMSG",$J,SRCNT)="",SRCNT=SRCNT+1
54 Q
55LINE ; store line in ^TMP
56 S ^TMP("SRMSG",$J,SRCNT)=SRLINE,SRCNT=SRCNT+1
57 Q
58HAIR ; hair removal methods
59 D BLANK,BLANK S SRBLANK="" F I=1:1:19 S SRBLANK=SRBLANK_" "
60 S SRLINE=SRBLANK_"PREOPERATIVE HAIR REMOVAL METHODS SUMMARY" D LINE
61 S SRLINE=SRBLANK_"-----------------------------------------" D LINE
62 D BLANK F I=1:1:23 S SRBLANK=SRBLANK_" "
63 S SRLINE=SRBLANK_"CASES % OF TOTAL" D LINE
64 S SRLINE=SRBLANK_"----- ----------" D LINE
65 S SRBLANK="" F I=1:1:15 S SRBLANK=SRBLANK_" "
66 S SRLINE=SRBLANK_" TOTAL CASES PERFORMED:"_$J(SRCASES,6)_" "
67 S:SRCASES SRLINE=SRLINE_"100.0" D LINE,BLANK
68 S SRLINE=SRBLANK_SRBLANK_" CLIPPER:"_$J(SRHAIR("C"),6)_" "
69 S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("C")/SRCASES)*100),5,1) D LINE
70 S SRLINE=SRBLANK_" DEPILATORY:"_$J(SRHAIR("D"),6)_" "
71 S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("D")/SRCASES)*100),5,1) D LINE
72 S SRLINE=SRBLANK_" NO HAIR REMOVED:"_$J(SRHAIR("N"),6)_" "
73 S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("N")/SRCASES)*100),5,1) D LINE
74 S SRLINE=SRBLANK_"PATIENT REMOVED OWN HAIR:"_$J(SRHAIR("P"),6)_" "
75 S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("P")/SRCASES)*100),5,1) D LINE
76 S SRLINE=SRBLANK_SRBLANK_" SHAVING:"_$J(SRHAIR("S"),6)_" "
77 S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("S")/SRCASES)*100),5,1) D LINE
78 N SRNDOC S SRNDOC=SRHAIR("U")+SRHAIR("ZZ")
79 S SRLINE=SRBLANK_" NOT DOCUMENTED:"_$J(SRNDOC,6)_" "
80 S:SRCASES SRLINE=SRLINE_$J(((SRNDOC/SRCASES)*100),5,1) D LINE
81 S SRLINE=SRBLANK_SRBLANK_" OTHER:"_$J(SRHAIR("O"),6)_" "
82 S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("O")/SRCASES)*100),5,1) D LINE
83 Q
Note: See TracBrowser for help on using the repository browser.