source: WorldVistAEHR/trunk/r/SURGERY-SR/SROQM.m@ 632

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1SROQM ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;03/22/06
2 ;;3.0; Surgery ;**62,82,95,123,126,129,153**; Jun 93;Build 11
3 ;** NOTICE: This routine is part of an implementation of a nationally
4 ;** controlled procedure. Local modifications to this routine
5 ;** are prohibited.
6 ;
7 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
8 D HDR,ENSURE,HAIR^SROQM1 K XMY
9 S X=$$ACTIVE^XUSER(DUZ) I '+X S XMDUZ=.5
10 S XMSUB="QUARTERLY REPORT - SURGICAL SERVICE"
11 S XMY("G.SR-QUARTERLY@"_SRD)=""
12 S XMTEXT="^TMP(""SRMSG"",$J," N I D ^XMD
13 K XMDUZ,XMY,^TMP("SRMSG",$J)
14 Q
15HDR ; write page header
16 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
17 S SRBLANK="" F I=1:1:22 S SRBLANK=SRBLANK_" "
18 S SRLINE=SRBLANK_"QUARTERLY REPORT - SURGICAL SERVICE",SRBLANK="" F I=1:1:(75-$L(SRLINE)) S SRBLANK=SRBLANK_" "
19 S SRLINE=SRLINE_SRBLANK_"PAGE" D LINE
20 S SRBLANK="" F I=1:1:34 S SRBLANK=SRBLANK_" "
21 S SRLINE=SRBLANK_"VERSION 3.0",SRBLANK="" F I=1:1:(77-$L(SRLINE)) S SRBLANK=SRBLANK_" "
22 S SRLINE=SRLINE_SRBLANK_SRPAGE D LINE
23 D BLANK S SRLINE=" Hospital: "_$E(SRINST,1,44),SRBLANK="" F I=1:1:(57-$L(SRLINE)) S SRBLANK=SRBLANK_" "
24 S SRLINE=SRLINE_SRBLANK_"Station Number: "_SRSTATN D LINE
25 S SRLINE=" For Dates: "_SRSD_" to: "_SRED_" Fiscal Year: "_SRYR D LINE
26 S SRLINE="" F I=1:1:79 S SRLINE=SRLINE_"="
27 D LINE S SRPAGE=SRPAGE+1
28 Q
29BLANK ; blank line
30 S ^TMP("SRMSG",$J,SRCNT)="",SRCNT=SRCNT+1
31 Q
32LINE ; store line in ^TMP
33 S ^TMP("SRMSG",$J,SRCNT)=SRLINE,SRCNT=SRCNT+1
34 Q
35ENSURE ; ensure correct surgery cpmpliance
36 D BLANK S SRBLANK="" F I=1:1:17 S SRBLANK=SRBLANK_" "
37 S SRLINE=SRBLANK_"ENSURING CORRECT SURGERY - COMPLIANCE SUMMARY" D LINE
38 S SRLINE=SRBLANK_"---------------------------------------------" D LINE
39 D BLANK F I=1:1:25 S SRBLANK=SRBLANK_" "
40 S SRLINE=SRBLANK_"CASES % OF TOTAL" D LINE
41 S SRLINE=SRBLANK_"----- ----------" D LINE
42 S SRBLANK="" F I=1:1:18 S SRBLANK=SRBLANK_" "
43 S SRLINE=SRBLANK_"TOTAL CASES PERFORMED:"_$J(SRCASES,6)_" "
44 S:SRCASES SRLINE=SRLINE_"100.0" D LINE,BLANK
45ETOV S SRLINE=SRBLANK_" TIME OUT VERIFIED" D LINE
46 S SRLINE=SRBLANK_SRBLANK_"YES:"_$J(SRTOV,6)_" "
47 S:SRCASES SRLINE=SRLINE_$J(((SRTOV/SRCASES)*100),5,1) D LINE
48 S SRLINE=SRBLANK_SRBLANK_" NO:"_$J(SRTONO,6)_" "
49 S:SRCASES SRLINE=SRLINE_$J(((SRTONO/SRCASES)*100),5,1) D LINE
50 S SRLINE=SRBLANK_" NOT ENTERED:"_$J(SRTONE,6)_" "
51 S:SRCASES SRLINE=SRLINE_$J(((SRTONE/SRCASES)*100),5,1) D LINE,BLANK
52EPRE S SRLINE=" PREOPERATIVE IMAGING CONFIRMED" D LINE
53 S SRLINE=SRBLANK_SRBLANK_"YES:"_$J(SRICY,6)_" "
54 S:SRCASES SRLINE=SRLINE_$J(((SRICY/SRCASES)*100),5,1) D LINE
55 S SRLINE=SRBLANK_" IMAGING NOT REQUIRED:"_$J(SRICNR,6)_" "
56 S:SRCASES SRLINE=SRLINE_$J(((SRICNR/SRCASES)*100),5,1) D LINE
57 S SRLINE=SRBLANK_SRBLANK_" NO:"_$J(SRICNO,6)_" "
58 S:SRCASES SRLINE=SRLINE_$J(((SRICNO/SRCASES)*100),5,1) D LINE
59 S SRLINE=SRBLANK_" NOT ENTERED:"_$J(SRICNE,6)_" "
60 S:SRCASES SRLINE=SRLINE_$J(((SRICNE/SRCASES)*100),5,1) D LINE,BLANK
61EMRK S SRLINE=" MARK ON SURGICAL SITE CONFIRMED" D LINE
62 S SRLINE=SRBLANK_SRBLANK_"YES:"_$J(SRSCY,6)_" "
63 S:SRCASES SRLINE=SRLINE_$J(((SRSCY/SRCASES)*100),5,1) D LINE
64 S SRLINE=SRBLANK_" MARKING NOT REQUIRED:"_$J(SRSCNR,6)_" "
65 S:SRCASES SRLINE=SRLINE_$J(((SRSCNR/SRCASES)*100),5,1) D LINE
66 S SRLINE=SRBLANK_SRBLANK_" NO:"_$J(SRSCNO,6)_" "
67 S:SRCASES SRLINE=SRLINE_$J(((SRSCNO/SRCASES)*100),5,1) D LINE
68 S SRLINE=SRBLANK_" NOT ENTERED:"_$J(SRSCNE,6)_" "
69 S:SRCASES SRLINE=SRLINE_$J(((SRSCNE/SRCASES)*100),5,1) D LINE D BLANK
70 ;
71 S SRLINE=SRBLANK_" OVERALL COMPLIANCE FOR THIS DATE RANGE" D LINE
72 S SRLINE=SRBLANK_" --------------------------------------" D LINE
73 S SRBLANK="" F I=1:1:17 S SRBLANK=SRBLANK_" "
74 S SRLINE=SRBLANK_SRBLANK_"TIME OUT VERIFIED: "
75 S:SRCASES SRLINE=SRLINE_$J(((SRTOV/SRCASES)*100),5,1)_"%" D LINE
76 S SRLINE=SRBLANK_" PREOPERATIVE IMAGING CONFIRMED: "
77 S:SRCASES SRLINE=SRLINE_$J((((SRICY+SRICNR)/SRCASES)*100),5,1)_"%" D LINE
78 S SRLINE=SRBLANK_" MARK ON SURGICAL SITE CONFIRMED: "
79 S:SRCASES SRLINE=SRLINE_$J((((SRSCY+SRSCNR)/SRCASES)*100),5,1)_"%" D LINE
80 Q
Note: See TracBrowser for help on using the repository browser.