SROQM ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;03/22/06
;;3.0; Surgery ;**62,82,95,123,126,129,153**; Jun 93;Build 11
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
S (SRCNT,SRPAGE)=1 K ^TMP("SRMSG",$J) D HDR Q:SRSOUT D ^SROQM0,HDR Q:SRSOUT D ^SROQM1 Q:SRSOUT F I=1:1:3 D BLANK
D HDR,ENSURE,HAIR^SROQM1 K XMY
S X=$$ACTIVE^XUSER(DUZ) I '+X S XMDUZ=.5
S XMSUB="QUARTERLY REPORT - SURGICAL SERVICE"
S XMY("G.SR-QUARTERLY@"_SRD)=""
S XMTEXT="^TMP(""SRMSG"",$J," N I D ^XMD
K XMDUZ,XMY,^TMP("SRMSG",$J)
Q
HDR ; write page header
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
S SRBLANK="" F I=1:1:22 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"QUARTERLY REPORT - SURGICAL SERVICE",SRBLANK="" F I=1:1:(75-$L(SRLINE)) S SRBLANK=SRBLANK_" "
S SRLINE=SRLINE_SRBLANK_"PAGE" D LINE
S SRBLANK="" F I=1:1:34 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"VERSION 3.0",SRBLANK="" F I=1:1:(77-$L(SRLINE)) S SRBLANK=SRBLANK_" "
S SRLINE=SRLINE_SRBLANK_SRPAGE D LINE
D BLANK S SRLINE=" Hospital: "_$E(SRINST,1,44),SRBLANK="" F I=1:1:(57-$L(SRLINE)) S SRBLANK=SRBLANK_" "
S SRLINE=SRLINE_SRBLANK_"Station Number: "_SRSTATN D LINE
S SRLINE=" For Dates: "_SRSD_" to: "_SRED_" Fiscal Year: "_SRYR D LINE
S SRLINE="" F I=1:1:79 S SRLINE=SRLINE_"="
D LINE S SRPAGE=SRPAGE+1
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
ENSURE ; ensure correct surgery cpmpliance
D BLANK S SRBLANK="" F I=1:1:17 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY" D LINE
S SRLINE=SRBLANK_"---------------------------------------------" D LINE
D BLANK F I=1:1:25 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"CASES % OF TOTAL" D LINE
S SRLINE=SRBLANK_"----- ----------" D LINE
S SRBLANK="" F I=1:1:18 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_"TOTAL CASES PERFORMED:"_$J(SRCASES,6)_" "
S:SRCASES SRLINE=SRLINE_"100.0" D LINE,BLANK
ETOV S SRLINE=SRBLANK_" TIME OUT VERIFIED" D LINE
S SRLINE=SRBLANK_SRBLANK_"YES:"_$J(SRTOV,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRTOV/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_SRBLANK_" NO:"_$J(SRTONO,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRTONO/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" NOT ENTERED:"_$J(SRTONE,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRTONE/SRCASES)*100),5,1) D LINE,BLANK
EPRE S SRLINE=" PREOPERATIVE IMAGING CONFIRMED" D LINE
S SRLINE=SRBLANK_SRBLANK_"YES:"_$J(SRICY,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRICY/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" IMAGING NOT REQUIRED:"_$J(SRICNR,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRICNR/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_SRBLANK_" NO:"_$J(SRICNO,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRICNO/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" NOT ENTERED:"_$J(SRICNE,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRICNE/SRCASES)*100),5,1) D LINE,BLANK
EMRK S SRLINE=" MARK ON SURGICAL SITE CONFIRMED" D LINE
S SRLINE=SRBLANK_SRBLANK_"YES:"_$J(SRSCY,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRSCY/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" MARKING NOT REQUIRED:"_$J(SRSCNR,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRSCNR/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_SRBLANK_" NO:"_$J(SRSCNO,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRSCNO/SRCASES)*100),5,1) D LINE
S SRLINE=SRBLANK_" NOT ENTERED:"_$J(SRSCNE,6)_" "
S:SRCASES SRLINE=SRLINE_$J(((SRSCNE/SRCASES)*100),5,1) D LINE D BLANK
;
S SRLINE=SRBLANK_" OVERALL COMPLIANCE FOR THIS DATE RANGE" D LINE
S SRLINE=SRBLANK_" --------------------------------------" D LINE
S SRBLANK="" F I=1:1:17 S SRBLANK=SRBLANK_" "
S SRLINE=SRBLANK_SRBLANK_"TIME OUT VERIFIED: "
S:SRCASES SRLINE=SRLINE_$J(((SRTOV/SRCASES)*100),5,1)_"%" D LINE
S SRLINE=SRBLANK_" PREOPERATIVE IMAGING CONFIRMED: "
S:SRCASES SRLINE=SRLINE_$J((((SRICY+SRICNR)/SRCASES)*100),5,1)_"%" D LINE
S SRLINE=SRBLANK_" MARK ON SURGICAL SITE CONFIRMED: "
S:SRCASES SRLINE=SRLINE_$J((((SRSCY+SRSCNR)/SRCASES)*100),5,1)_"%" D LINE
Q
SROQM ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;03/22/06
+1 ;;3.0; Surgery ;**62,82,95,123,126,129,153**; Jun 93;Build 11
+2 ;** NOTICE: This routine is part of an implementation of a nationally
+3 ;** controlled procedure. Local modifications to this routine
+4 ;** are prohibited.
+5 ;
+6 SET (SRCNT,SRPAGE)=1
KILL ^TMP("SRMSG",$JOB)
DO HDR
IF SRSOUT
QUIT
DO ^SROQM0
DO HDR
IF SRSOUT
QUIT
DO ^SROQM1
IF SRSOUT
QUIT
FOR I=1:1:3
DO BLANK
+7 DO HDR
DO ENSURE
DO HAIR^SROQM1
KILL XMY
+8 SET X=$$ACTIVE^XUSER(DUZ)
IF '+X
SET XMDUZ=.5
+9 SET XMSUB="QUARTERLY REPORT - SURGICAL SERVICE"
+10 SET XMY("G.SR-QUARTERLY@"_SRD)=""
+11 SET XMTEXT="^TMP(""SRMSG"",$J,"
NEW I
DO ^XMD
+12 KILL XMDUZ,XMY,^TMP("SRMSG",$JOB)
+13 QUIT
HDR ; write page header
+1 IF $DATA(ZTQUEUED)
DO ^SROSTOP
IF SRHALT
SET SRSOUT=1
QUIT
+2 SET SRBLANK=""
FOR I=1:1:22
SET SRBLANK=SRBLANK_" "
+3 SET SRLINE=SRBLANK_"QUARTERLY REPORT - SURGICAL SERVICE"
SET SRBLANK=""
FOR I=1:1:(75-$LENGTH(SRLINE))
SET SRBLANK=SRBLANK_" "
+4 SET SRLINE=SRLINE_SRBLANK_"PAGE"
DO LINE
+5 SET SRBLANK=""
FOR I=1:1:34
SET SRBLANK=SRBLANK_" "
+6 SET SRLINE=SRBLANK_"VERSION 3.0"
SET SRBLANK=""
FOR I=1:1:(77-$LENGTH(SRLINE))
SET SRBLANK=SRBLANK_" "
+7 SET SRLINE=SRLINE_SRBLANK_SRPAGE
DO LINE
+8 DO BLANK
SET SRLINE=" Hospital: "_$EXTRACT(SRINST,1,44)
SET SRBLANK=""
FOR I=1:1:(57-$LENGTH(SRLINE))
SET SRBLANK=SRBLANK_" "
+9 SET SRLINE=SRLINE_SRBLANK_"Station Number: "_SRSTATN
DO LINE
+10 SET SRLINE=" For Dates: "_SRSD_" to: "_SRED_" Fiscal Year: "_SRYR
DO LINE
+11 SET SRLINE=""
FOR I=1:1:79
SET SRLINE=SRLINE_"="
+12 DO LINE
SET SRPAGE=SRPAGE+1
+13 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
ENSURE ; ensure correct surgery cpmpliance
+1 DO BLANK
SET SRBLANK=""
FOR I=1:1:17
SET SRBLANK=SRBLANK_" "
+2 SET SRLINE=SRBLANK_"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY"
DO LINE
+3 SET SRLINE=SRBLANK_"---------------------------------------------"
DO LINE
+4 DO BLANK
FOR I=1:1:25
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:18
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
ETOV SET SRLINE=SRBLANK_" TIME OUT VERIFIED"
DO LINE
+1 SET SRLINE=SRBLANK_SRBLANK_"YES:"_$JUSTIFY(SRTOV,6)_" "
+2 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRTOV/SRCASES)*100),5,1)
DO LINE
+3 SET SRLINE=SRBLANK_SRBLANK_" NO:"_$JUSTIFY(SRTONO,6)_" "
+4 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRTONO/SRCASES)*100),5,1)
DO LINE
+5 SET SRLINE=SRBLANK_" NOT ENTERED:"_$JUSTIFY(SRTONE,6)_" "
+6 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRTONE/SRCASES)*100),5,1)
DO LINE
DO BLANK
EPRE SET SRLINE=" PREOPERATIVE IMAGING CONFIRMED"
DO LINE
+1 SET SRLINE=SRBLANK_SRBLANK_"YES:"_$JUSTIFY(SRICY,6)_" "
+2 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRICY/SRCASES)*100),5,1)
DO LINE
+3 SET SRLINE=SRBLANK_" IMAGING NOT REQUIRED:"_$JUSTIFY(SRICNR,6)_" "
+4 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRICNR/SRCASES)*100),5,1)
DO LINE
+5 SET SRLINE=SRBLANK_SRBLANK_" NO:"_$JUSTIFY(SRICNO,6)_" "
+6 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRICNO/SRCASES)*100),5,1)
DO LINE
+7 SET SRLINE=SRBLANK_" NOT ENTERED:"_$JUSTIFY(SRICNE,6)_" "
+8 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRICNE/SRCASES)*100),5,1)
DO LINE
DO BLANK
EMRK SET SRLINE=" MARK ON SURGICAL SITE CONFIRMED"
DO LINE
+1 SET SRLINE=SRBLANK_SRBLANK_"YES:"_$JUSTIFY(SRSCY,6)_" "
+2 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRSCY/SRCASES)*100),5,1)
DO LINE
+3 SET SRLINE=SRBLANK_" MARKING NOT REQUIRED:"_$JUSTIFY(SRSCNR,6)_" "
+4 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRSCNR/SRCASES)*100),5,1)
DO LINE
+5 SET SRLINE=SRBLANK_SRBLANK_" NO:"_$JUSTIFY(SRSCNO,6)_" "
+6 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRSCNO/SRCASES)*100),5,1)
DO LINE
+7 SET SRLINE=SRBLANK_" NOT ENTERED:"_$JUSTIFY(SRSCNE,6)_" "
+8 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRSCNE/SRCASES)*100),5,1)
DO LINE
DO BLANK
+9 ;
+10 SET SRLINE=SRBLANK_" OVERALL COMPLIANCE FOR THIS DATE RANGE"
DO LINE
+11 SET SRLINE=SRBLANK_" --------------------------------------"
DO LINE
+12 SET SRBLANK=""
FOR I=1:1:17
SET SRBLANK=SRBLANK_" "
+13 SET SRLINE=SRBLANK_SRBLANK_"TIME OUT VERIFIED: "
+14 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY(((SRTOV/SRCASES)*100),5,1)_"%"
DO LINE
+15 SET SRLINE=SRBLANK_" PREOPERATIVE IMAGING CONFIRMED: "
+16 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY((((SRICY+SRICNR)/SRCASES)*100),5,1)_"%"
DO LINE
+17 SET SRLINE=SRBLANK_" MARK ON SURGICAL SITE CONFIRMED: "
+18 IF SRCASES
SET SRLINE=SRLINE_$JUSTIFY((((SRSCY+SRSCNR)/SRCASES)*100),5,1)_"%"
DO LINE
+19 QUIT
