source: FOIAVistA/trunk/r/SURGERY-SR/SROPECS1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1SROPECS1 ;BIR/ADM-Ensuring Correct Surgery Compliance Report, continued ; [ 06/03/04 2:10 PM ]
2 ;;3.0; Surgery ;**120,129**;24 Jun 9
3 S (SRHDRL,SRNEW)=0 I SRFLG'=1 S SRHDRL=1 D HDR,TMP
4 I 'SRSOUT,SRFLG'=2 D SUM
5 Q
6TMP ; print cases stored in ^TMP
7 I SRORD S SRSS="" D NONE F S SRSS=$O(^TMP("SRLIST",$J,SRSS)) Q:SRSS=""!SRSOUT D NEWSP D
8 .S SRSDT="" F S SRSDT=$O(^TMP("SRLIST",$J,SRSS,SRSDT)) Q:'SRSDT!SRSOUT S SRTN=0 F S SRTN=$O(^TMP("SRLIST",$J,SRSS,SRSDT,SRTN)) Q:'SRTN!SRSOUT D
9 ..S SRC=^TMP("SRLIST",$J,SRSS,SRSDT,SRTN),DFN=$P(SRC,"^"),SR71=$P(SRC,"^",2),SR72=$P(SRC,"^",3),SR73=$P(SRC,"^",4) D CASE
10 I 'SRORD S SRSDT="" D NONE F S SRSDT=$O(^TMP("SRLIST",$J,SRSDT)) Q:'SRSDT!SRSOUT S SRTN=0 F S SRTN=$O(^TMP("SRLIST",$J,SRSDT,SRTN)) Q:'SRTN!SRSOUT D
11 .S SRC=^TMP("SRLIST",$J,SRSDT,SRTN),DFN=$P(SRC,"^"),SR71=$P(SRC,"^",2),SR72=$P(SRC,"^",3),SRSS=$P(SRC,"^",4),SR73=$P(SRC,"^",5)
12 .S SRSPEC=SRSS D CASE
13 Q
14NEWSP S SRSPEC=SRSS,SRNEW=1 I $E(SRSS,1,2)="ZZ" S SRSPEC=$E(SRSS,3,50)
15 I $Y+9>IOSL D PAGE Q
16SPNAME W !,">>> SPECIALTY: "_SRSPEC_$S('SRNEW:" (continued)",1:"")," <<<",!
17 S SRNEW=0
18 Q
19NONE ; no cases to list
20 I SRORD,$O(^TMP("SRLIST",$J,SRSS))="" D ZERO Q
21 I 'SRORD,$O(^TMP("SRLIST",$J,SRSDT))="" D ZERO Q
22 Q
23ZERO W !,"NO NON-COMPLIANT SURGICAL CASES WERE FOUND FOR THIS DATE RANGE."
24 Q
25SUM ; print summary
26 S SRTAG="COMPLIANCE SUMMARY",SRHDRL=0 D PAGE
27 W !,?42,"CASES % OF TOTAL",!,?42,"----- ----------"
28 W !,?18,"TOTAL CASES PERFORMED:"_$J(SRTOT,6),?53,"100.0"
29 W !!,?22,"TIME OUT VERIFIED",!,?36,"YES:"_$J(SRTOV,6) W:SRTOT ?53,$J(((SRTOV/SRTOT)*100),5,1)
30 W !,?37,"NO:"_$J(SRTONO,6) W:SRTOT ?53,$J(((SRTONO/SRTOT)*100),5,1)
31 W !,?28,"NOT ENTERED:"_$J(SRTONE,6) W:SRTOT ?53,$J(((SRTONE/SRTOT)*100),5,1)
32 W !!,?9,"PREOPERATIVE IMAGING CONFIRMED",!,?36,"YES:"_$J(SRICY,6) W:SRTOT ?53,$J(((SRICY/SRTOT)*100),5,1)
33 W !,?19,"IMAGING NOT REQUIRED:"_$J(SRICNR,6) W:SRTOT ?53,$J(((SRICNR/SRTOT)*100),5,1)
34 W !,?37,"NO:"_$J(SRICNO,6) W:SRTOT ?53,$J(((SRICNO/SRTOT)*100),5,1)
35 W !,?28,"NOT ENTERED:"_$J(SRICNE,6) W:SRTOT ?53,$J(((SRICNE/SRTOT)*100),5,1)
36 W !!,?8,"MARK ON SURGICAL SITE CONFIRMED",!,?36,"YES:"_$J(SRSCY,6) W:SRTOT ?53,$J(((SRSCY/SRTOT)*100),5,1)
37 W !,?19,"MARKING NOT REQUIRED:"_$J(SRSCNR,6) W:SRTOT ?53,$J(((SRSCNR/SRTOT)*100),5,1)
38 W !,?37,"NO:"_$J(SRSCNO,6) W:SRTOT ?53,$J(((SRSCNO/SRTOT)*100),5,1)
39 W !,?28,"NOT ENTERED:"_$J(SRSCNE,6) W:SRTOT ?53,$J(((SRSCNE/SRTOT)*100),5,1)
40 W !!,?20,"OVERALL COMPLIANCE FOR THIS DATE RANGE",!,?20,"--------------------------------------"
41 W !,?34,"TIME OUT VERIFIED: " W:SRTOT $J(((SRTOV/SRTOT)*100),5,1),"%"
42 W !,?21,"PREOPERATIVE IMAGING CONFIRMED: " W:SRTOT $J((((SRICY+SRICNR)/SRTOT)*100),5,1),"%"
43 W !,?20,"MARK ON SURGICAL SITE CONFIRMED: " W:SRTOT $J((((SRSCY+SRSCNR)/SRTOT)*100),5,1),"%"
44 Q
45DEM ; get patient demographic information
46 D DEM^VADPT S SRSNM=VADM(1),SRSSN=VA("PID")
47 S Y=SRSDT X ^DD("DD") S SRSDATE=Y,X1=$E(SRSDT,1,7),X2=$P(VADM(3),"^"),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
48 S Y=$P($G(^SRF(SRTN,.1)),"^",13),C=$P(^DD(130,.164,0),"^",2) D:Y'="" Y^DIQ S SRATT=$S(Y'="":$E(Y,1,29),1:"<NOT ENTERED>")
49 S SRCST="",Y=$P(^SRF(SRTN,0),"^",10) S:Y'="" SRCST=$S(Y="EM":"EMERGENCY",Y="EL":"ELECTIVE",Y="A":"ADD ON (NON-EMERGENT)",Y="S":"STANDBY",Y="U":"URGENT",1:"")
50 S SRCIRC="",Y=$O(^SRF(SRTN,19,0)) S:Y SRCIRC=$P($G(^SRF(SRTN,19,Y,0)),"^")
51 S Y=SRCIRC,C=$P(^DD(130.28,.01,0),"^",2) D:Y'="" Y^DIQ S SRCIRC=$S(Y'="":$E(Y,1,29),1:"<NOT ENTERED>")
52PROC ; get principal procedure
53 K SRPROC S X=$P(^SRF(SRTN,"OP"),"^") I $L(X)<49 S SRPROC(1)=X
54 I $L(X)>48 S K=1 F D I $L(X)<49 S SRPROC(K)=X Q
55 .F I=0:1:47 S J=48-I,Y=$E(X,J) I Y=" " S SRPROC(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
56 Q
57CASE ; print case info
58 D DEM D:$Y+6>IOSL PAGE Q:SRSOUT
59 I $E(SRSS,1,2)="ZZ" S SRSPEC=$E(SRSS,3,40)
60 W !,SRSDATE,?32,SRATT,?62,$S(SR71="Y":"YES",SR71="N":"NO",1:"<NOT ENTERED>")
61 W !,SRSNM,?32,SRCIRC,?62,$S(SR72="Y":"YES",SR72="N":"NO",SR72="I":"NOT REQUIRED",1:"<NOT ENTERED>")
62 W !,SRSSN_" ("_SRAGE_")",?21,SRTN,?32,SRPROC(1),?62,$S(SR73="Y":"YES",SR73="N":"NO",SR73="M":"NOT REQUIRED",1:"<NOT ENTERED>")
63 I 'SRORD W !,"("_$E(SRSPEC,1,28)_")" W:$D(SRPROC(2)) ?32,SRPROC(2)
64 I SRORD W:$D(SRPROC(2)) !,?32,SRPROC(2)
65 W:$D(SRPROC(3)) !,?32,SRPROC(3) W:$D(SRPROC(4)) !,?32,SRPROC(4)
66 W !,SRCST,!
67 F I=82,83,84 W !,$S(I=82:"TIME OUT VERIFY COMMENTS:",I=83:"PREOPERATIVE IMAGING CONFIRMED COMMENTS:",1:"MARKED SITE CONFIRMED COMMENTS:") D
68 .I '$O(^SRF(SRTN,I,0)) W !,?2,"<NOT ENTERED>",! Q
69 .S SRSJ=0 F S SRSJ=$O(^SRF(SRTN,I,SRSJ)) Q:'SRSJ W !,?2,$G(^SRF(SRTN,I,SRSJ,0))
70 .W !
71 W ! F I=1:1:80 W "-"
72 Q
73PAGE I $E(IOST)="P"!SRHDR G HDR
74 W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
75HDR ; print heading
76 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
77 S SRTITLE=SRRPT_" - "_SRTAG
78 W:$Y @IOF W:$E(IOST)="P" !,?(80-$L(SRINST)\2),SRINST W !,?(80-$L(SRTITLE)\2),SRTITLE,?70,$J("PAGE "_SRPAGE,9),!,?(80-$L(SRFRTO)\2),SRFRTO W:$E(IOST)="P" !,?(80-$L(SRPRINT)\2),SRPRINT
79 I SRHDRL D
80 .W !!,"DATE OF OPERATION",?32,"ATTENDING SURGEON",?62,"TIME OUT VERIFIED"
81 .W !,"PATIENT NAME",?32,"CIRCULATING NURSE",?62,"IMAGING CONFIRMED"
82 .W !,"PATIENT ID (AGE)",?21,"CASE #",?32,"PRINCIPAL PROCEDURE",?62,"MARK SITE CONFIRM"
83 .W !,"CASE SCHEDULE TYPE"
84 S SRPAGE=SRPAGE+1 W ! F I=1:1:80 W "="
85 I 'SRHDR,SRHDRL,SRORD D SPNAME
86 S SRHDR=0
87 Q
Note: See TracBrowser for help on using the repository browser.