SROQM1 ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;01/30/07
;;3.0; Surgery ;**38,62,70,129,153,160**;24 Jun 93;Build 7
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
NDEX ; index procedures
D BLANK S SRBLANK="" F I=1:1:31 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"INDEX PROCEDURES" D LINE S SRLINE=SRBLANK_"----------------" D LINE
F I=1:1:22 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"CASES WITH" D LINE S SRBLANK="" F I=1:1:29 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"CASES DEATHS OCCURRENCES" D LINE
S SRLINE=SRBLANK_"----- ------ -----------" D LINE
F J=1:1:12 D IXUT
CC ; occurrence categories
D BLANK S SRBLANK="" F I=1:1:21 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"PERIOPERATIVE OCCURRENCE CATEGORIES" D LINE S SRLINE=SRBLANK_"-----------------------------------" D LINE
WC D BLANK S SRLINE=" Wound Occurrences Total Urinary Occurrences Total" D LINE
S SRLINE=" A. Superficial Incisional SSI"_$J(SRC(1),5)_" A. Renal Insufficiency "_$J(SRC(8),5) D LINE
S SRLINE=" B. Deep Incisional SSI "_$J(SRC(2),5)_" B. Acute Renal Failure "_$J(SRC(9),5) D LINE
S SRLINE=" C. Wound Disruption "_$J(SRC(22),5)_" C. Urinary Tract Infection "_$J(SRC(10),5) D LINE
S SRLINE=" D. Other "_$J(SRC(36),5)_" D. Other "_$J(SRC(31),5) D LINE,BLANK
RC S SRLINE=" Respiratory Occurrences Total CNS Occurrences Total" D LINE
S SRLINE=" A. Pneumonia "_$J(SRC(4),5)_" A. CVA/Stroke "_$J((SRC(12)+SRC(28)),5) D LINE
S SRLINE=" B. Unplanned Intubation "_$J((SRC(7)+SRC(11)),5)_" B. Coma >24 Hours "_$J(SRC(13),5) D LINE
S SRLINE=" C. Pulmonary Embolism "_$J(SRC(5),5)_" C. Peripheral Nerve Injury "_$J(SRC(14),5) D LINE
S SRLINE=" D. On Ventilator >48 Hours "_$J(SRC(6),5)_" D. Other "_$J(SRC(30),5) D LINE
S SRLINE=" E. Tracheostomy "_$J(SRC(33),5) D LINE
S SRLINE=" F. Repeat Vent w/in 30 Days "_$J(SRC(37),5) D LINE
S SRLINE=" G. Other "_$J(SRC(29),5) D LINE
S SRBLANK="" F I=1:1:41 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"Other Occurrences Total" D LINE
CARD S SRLINE=" Cardiac Occurrences Total A. Organ/Space SSI "_$J(SRC(35),5) D LINE
S SRLINE=" A. Cardiac Arrest Req. CPR "_$J(SRC(16),5)_" B. Bleeding/Transfusions "_$J(SRC(15),5) D LINE
S SRLINE=" B. Myocardial Infarction "_$J(SRC(17),5)_" C. Graft/Prosthesis/Flap" D LINE
S SRLINE=" C. Endocarditis "_$J(SRC(23),5)_" Failure "_$J(SRC(19),5) D LINE
S SRLINE=" D. Low Cardiac Output >6 Hrs."_$J(SRC(24),5)_" D. DVT/Thrombophlebitis "_$J(SRC(20),5) D LINE
S SRLINE=" E. Mediastinitis "_$J(SRC(25),5)_" E. Systemic Sepsis "_$J(SRC(3),5) D LINE
S SRLINE=" F. Repeat Card Surg Proc "_$J(SRC(27),5)_" F. Reoperation for Bleeding "_$J(SRC(26),5) D LINE
S SRLINE=" G. New Mech Circulatory Sup "_$J(SRC(34),5)_" G. C. difficile Colitis "_$J(SRC(38),5) D LINE
S SRLINE=" H. Other "_$J(SRC(32),5)_" H. Other "_$J(SRC(21),5) D LINE,BLANK
S:'SRWC SRWC=1 S SRLINE=" Clean Wound Infection Rate: "_$J((SRIN/SRWC*100),5,1)_"%" D LINE
Q
IXUT ; get 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["," D S SROP=$P(SROP,",",2)
..I J=7 S SRLINE=" "_$P(SROP,",") D LINE
.S SRLINE=" "_SROP S SRBLANK="" F I=1:1:(28-$L(SRLINE)) S SRBLANK=SRBLANK_" "
S SRLINE=SRLINE_SRBLANK_$J(SRP(1),6)_" "_$J(SRP(3),6)_" "_$J(SRP(2),6) 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
HAIR ; hair removal methods
D BLANK,BLANK S SRBLANK="" F I=1:1:19 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"PREOPERATIVE HAIR REMOVAL METHODS SUMMARY" D LINE
S SRLINE=SRBLANK_"-----------------------------------------" D LINE
D BLANK F I=1:1:23 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"CASES % OF TOTAL" D LINE
S SRLINE=SRBLANK_"----- ----------" D LINE
S SRBLANK="" F I=1:1:15 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_" TOTAL CASES PERFORMED:"_$J(SRCASES,6)_" "
S:SRCASES SRLINE=SRLINE_"100.0" D LINE,BLANK
S SRLINE=SRBLANK_SRBLANK_" CLIPPER:"_$J(SRHAIR("C"),6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("C")/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" DEPILATORY:"_$J(SRHAIR("D"),6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("D")/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" NO HAIR REMOVED:"_$J(SRHAIR("N"),6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("N")/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_"PATIENT REMOVED OWN HAIR:"_$J(SRHAIR("P"),6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("P")/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_SRBLANK_" SHAVING:"_$J(SRHAIR("S"),6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("S")/SRCASES)*100),5,1) D LINE
N SRNDOC S SRNDOC=SRHAIR("U")+SRHAIR("ZZ")
S SRLINE=SRBLANK_" NOT DOCUMENTED:"_$J(SRNDOC,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRNDOC/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_SRBLANK_" OTHER:"_$J(SRHAIR("O"),6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRHAIR("O")/SRCASES)*100),5,1) D LINE
Q
SROQM1 ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;01/30/07
+1 ;;3.0; Surgery ;**38,62,70,129,153,160**;24 Jun 93;Build 7
+2 ;** NOTICE: This routine is part of an implementation of a nationally
+3 ;** controlled procedure. Local modifications to this routine
+4 ;** are prohibited.
+5 ;
NDEX ; index procedures
+1 DO BLANK
SET SRBLANK=""
FOR I=1:1:31
SET SRBLANK=SRBLANK_" "
+2 SET SRLINE=SRBLANK_"INDEX PROCEDURES"
DO LINE
SET SRLINE=SRBLANK_"----------------"
DO LINE
+3 FOR I=1:1:22
SET SRBLANK=SRBLANK_" "
+4 SET SRLINE=SRBLANK_"CASES WITH"
DO LINE
SET SRBLANK=""
FOR I=1:1:29
SET SRBLANK=SRBLANK_" "
+5 SET SRLINE=SRBLANK_"CASES DEATHS OCCURRENCES"
DO LINE
+6 SET SRLINE=SRBLANK_"----- ------ -----------"
DO LINE
+7 FOR J=1:1:12
DO IXUT
CC ; occurrence categories
+1 DO BLANK
SET SRBLANK=""
FOR I=1:1:21
SET SRBLANK=SRBLANK_" "
+2 SET SRLINE=SRBLANK_"PERIOPERATIVE OCCURRENCE CATEGORIES"
DO LINE
SET SRLINE=SRBLANK_"-----------------------------------"
DO LINE
WC DO BLANK
SET SRLINE=" Wound Occurrences Total Urinary Occurrences Total"
DO LINE
+1 SET SRLINE=" A. Superficial Incisional SSI"_$JUSTIFY(SRC(1),5)_" A. Renal Insufficiency "_$JUSTIFY(SRC(8),5)
DO LINE
+2 SET SRLINE=" B. Deep Incisional SSI "_$JUSTIFY(SRC(2),5)_" B. Acute Renal Failure "_$JUSTIFY(SRC(9),5)
DO LINE
+3 SET SRLINE=" C. Wound Disruption "_$JUSTIFY(SRC(22),5)_" C. Urinary Tract Infection "_$JUSTIFY(SRC(10),5)
DO LINE
+4 SET SRLINE=" D. Other "_$JUSTIFY(SRC(36),5)_" D. Other "_$JUSTIFY(SRC(31),5)
DO LINE
DO BLANK
RC SET SRLINE=" Respiratory Occurrences Total CNS Occurrences Total"
DO LINE
+1 SET SRLINE=" A. Pneumonia "_$JUSTIFY(SRC(4),5)_" A. CVA/Stroke "_$JUSTIFY((SRC(12)+SRC(28)),5)
DO LINE
+2 SET SRLINE=" B. Unplanned Intubation "_$JUSTIFY((SRC(7)+SRC(11)),5)_" B. Coma >24 Hours "_$JUSTIFY(SRC(13),5)
DO LINE
+3 SET SRLINE=" C. Pulmonary Embolism "_$JUSTIFY(SRC(5),5)_" C. Peripheral Nerve Injury "_$JUSTIFY(SRC(14),5)
DO LINE
+4 SET SRLINE=" D. On Ventilator >48 Hours "_$JUSTIFY(SRC(6),5)_" D. Other "_$JUSTIFY(SRC(30),5)
DO LINE
+5 SET SRLINE=" E. Tracheostomy "_$JUSTIFY(SRC(33),5)
DO LINE
+6 SET SRLINE=" F. Repeat Vent w/in 30 Days "_$JUSTIFY(SRC(37),5)
DO LINE
+7 SET SRLINE=" G. Other "_$JUSTIFY(SRC(29),5)
DO LINE
+8 SET SRBLANK=""
FOR I=1:1:41
SET SRBLANK=SRBLANK_" "
+9 SET SRLINE=SRBLANK_"Other Occurrences Total"
DO LINE
CARD SET SRLINE=" Cardiac Occurrences Total A. Organ/Space SSI "_$JUSTIFY(SRC(35),5)
DO LINE
+1 SET SRLINE=" A. Cardiac Arrest Req. CPR "_$JUSTIFY(SRC(16),5)_" B. Bleeding/Transfusions "_$JUSTIFY(SRC(15),5)
DO LINE
+2 SET SRLINE=" B. Myocardial Infarction "_$JUSTIFY(SRC(17),5)_" C. Graft/Prosthesis/Flap"
DO LINE
+3 SET SRLINE=" C. Endocarditis "_$JUSTIFY(SRC(23),5)_" Failure "_$JUSTIFY(SRC(19),5)
DO LINE
+4 SET SRLINE=" D. Low Cardiac Output >6 Hrs."_$JUSTIFY(SRC(24),5)_" D. DVT/Thrombophlebitis "_$JUSTIFY(SRC(20),5)
DO LINE
+5 SET SRLINE=" E. Mediastinitis "_$JUSTIFY(SRC(25),5)_" E. Systemic Sepsis "_$JUSTIFY(SRC(3),5)
DO LINE
+6 SET SRLINE=" F. Repeat Card Surg Proc "_$JUSTIFY(SRC(27),5)_" F. Reoperation for Bleeding "_$JUSTIFY(SRC(26),5)
DO LINE
+7 SET SRLINE=" G. New Mech Circulatory Sup "_$JUSTIFY(SRC(34),5)_" G. C. difficile Colitis "_$JUSTIFY(SRC(38),5)
DO LINE
+8 SET SRLINE=" H. Other "_$JUSTIFY(SRC(32),5)_" H. Other "_$JUSTIFY(SRC(21),5)
DO LINE
DO BLANK
+9 IF 'SRWC
SET SRWC=1
SET SRLINE=" Clean Wound Infection Rate: "_$JUSTIFY((SRIN/SRWC*100),5,1)_"%"
DO LINE
+10 QUIT
IXUT ; get 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[","
Begin DoDot:2
+4 IF J=7
SET SRLINE=" "_$PIECE(SROP,",")
DO LINE
End DoDot:2
SET SROP=$PIECE(SROP,",",2)
+5 SET SRLINE=" "_SROP
SET SRBLANK=""
FOR I=1:1:(28-$LENGTH(SRLINE))
SET SRBLANK=SRBLANK_" "
End DoDot:1
+6 SET SRLINE=SRLINE_SRBLANK_$JUSTIFY(SRP(1),6)_" "_$JUSTIFY(SRP(3),6)_" "_$JUSTIFY(SRP(2),6)
DO LINE
+7 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
HAIR ; hair removal methods
+1 DO BLANK
DO BLANK
SET SRBLANK=""
FOR I=1:1:19
SET SRBLANK=SRBLANK_" "
+2 SET SRLINE=SRBLANK_"PREOPERATIVE HAIR REMOVAL METHODS SUMMARY"
DO LINE
+3 SET SRLINE=SRBLANK_"-----------------------------------------"
DO LINE
+4 DO BLANK
FOR I=1:1:23
SET SRBLANK=SRBLANK_" "
+5 SET SRLINE=SRBLANK_"CASES % OF TOTAL"
DO LINE
+6 SET SRLINE=SRBLANK_"----- ----------"
DO LINE
+7 SET SRBLANK=""
FOR I=1:1:15
SET SRBLANK=SRBLANK_" "
+8 SET SRLINE=SRBLANK_" TOTAL CASES PERFORMED:"_$JUSTIFY(SRCASES,6)_" "
+9 IF SRCASES
SET SRLINE=SRLINE_"100.0"
DO LINE
DO BLANK
+10 SET SRLINE=SRBLANK_SRBLANK_" CLIPPER:"_$JUSTIFY(SRHAIR("C"),6)_" "
+11 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRHAIR("C")/SRCASES)*100),5,1)
DO LINE
+12 SET SRLINE=SRBLANK_" DEPILATORY:"_$JUSTIFY(SRHAIR("D"),6)_" "
+13 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRHAIR("D")/SRCASES)*100),5,1)
DO LINE
+14 SET SRLINE=SRBLANK_" NO HAIR REMOVED:"_$JUSTIFY(SRHAIR("N"),6)_" "
+15 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRHAIR("N")/SRCASES)*100),5,1)
DO LINE
+16 SET SRLINE=SRBLANK_"PATIENT REMOVED OWN HAIR:"_$JUSTIFY(SRHAIR("P"),6)_" "
+17 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRHAIR("P")/SRCASES)*100),5,1)
DO LINE
+18 SET SRLINE=SRBLANK_SRBLANK_" SHAVING:"_$JUSTIFY(SRHAIR("S"),6)_" "
+19 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRHAIR("S")/SRCASES)*100),5,1)
DO LINE
+20 NEW SRNDOC
SET SRNDOC=SRHAIR("U")+SRHAIR("ZZ")
+21 SET SRLINE=SRBLANK_" NOT DOCUMENTED:"_$JUSTIFY(SRNDOC,6)_" "
+22 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRNDOC/SRCASES)*100),5,1)
DO LINE
+23 SET SRLINE=SRBLANK_SRBLANK_" OTHER:"_$JUSTIFY(SRHAIR("O"),6)_" "
+24 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRHAIR("O")/SRCASES)*100),5,1)
DO LINE
+25 QUIT
