source: FOIAVistA/tag/r/SURGERY-SR/SROQM.m@ 1694

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