SROPECS1 ;BIR/ADM-Ensuring Correct Surgery Compliance Report, continued ; [ 06/03/04  2:10 PM ]
 ;;3.0; Surgery ;**120,129**;24 Jun 9
 S (SRHDRL,SRNEW)=0 I SRFLG'=1 S SRHDRL=1 D HDR,TMP
 I 'SRSOUT,SRFLG'=2 D SUM
 Q
TMP ; print cases stored in ^TMP
 I SRORD S SRSS="" D NONE F  S SRSS=$O(^TMP("SRLIST",$J,SRSS)) Q:SRSS=""!SRSOUT  D NEWSP D
 .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
 ..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
 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
 .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)
 .S SRSPEC=SRSS D CASE
 Q
NEWSP S SRSPEC=SRSS,SRNEW=1 I $E(SRSS,1,2)="ZZ" S SRSPEC=$E(SRSS,3,50)
 I $Y+9>IOSL D PAGE Q
SPNAME W !,">>> SPECIALTY: "_SRSPEC_$S('SRNEW:" (continued)",1:"")," <<<",!
 S SRNEW=0
 Q
NONE ; no cases to list
 I SRORD,$O(^TMP("SRLIST",$J,SRSS))="" D ZERO Q
 I 'SRORD,$O(^TMP("SRLIST",$J,SRSDT))="" D ZERO Q
 Q
ZERO W !,"NO NON-COMPLIANT SURGICAL CASES WERE FOUND FOR THIS DATE RANGE."
 Q
SUM ; print summary
 S SRTAG="COMPLIANCE SUMMARY",SRHDRL=0 D PAGE
 W !,?42,"CASES    % OF TOTAL",!,?42,"-----    ----------"
 W !,?18,"TOTAL CASES PERFORMED:"_$J(SRTOT,6),?53,"100.0"
 W !!,?22,"TIME OUT VERIFIED",!,?36,"YES:"_$J(SRTOV,6) W:SRTOT ?53,$J(((SRTOV/SRTOT)*100),5,1)
 W !,?37,"NO:"_$J(SRTONO,6) W:SRTOT ?53,$J(((SRTONO/SRTOT)*100),5,1)
 W !,?28,"NOT ENTERED:"_$J(SRTONE,6) W:SRTOT ?53,$J(((SRTONE/SRTOT)*100),5,1)
 W !!,?9,"PREOPERATIVE IMAGING CONFIRMED",!,?36,"YES:"_$J(SRICY,6) W:SRTOT ?53,$J(((SRICY/SRTOT)*100),5,1)
 W !,?19,"IMAGING NOT REQUIRED:"_$J(SRICNR,6) W:SRTOT ?53,$J(((SRICNR/SRTOT)*100),5,1)
 W !,?37,"NO:"_$J(SRICNO,6) W:SRTOT ?53,$J(((SRICNO/SRTOT)*100),5,1)
 W !,?28,"NOT ENTERED:"_$J(SRICNE,6) W:SRTOT ?53,$J(((SRICNE/SRTOT)*100),5,1)
 W !!,?8,"MARK ON SURGICAL SITE CONFIRMED",!,?36,"YES:"_$J(SRSCY,6) W:SRTOT ?53,$J(((SRSCY/SRTOT)*100),5,1)
 W !,?19,"MARKING NOT REQUIRED:"_$J(SRSCNR,6) W:SRTOT ?53,$J(((SRSCNR/SRTOT)*100),5,1)
 W !,?37,"NO:"_$J(SRSCNO,6) W:SRTOT ?53,$J(((SRSCNO/SRTOT)*100),5,1)
 W !,?28,"NOT ENTERED:"_$J(SRSCNE,6) W:SRTOT ?53,$J(((SRSCNE/SRTOT)*100),5,1)
 W !!,?20,"OVERALL COMPLIANCE FOR THIS DATE RANGE",!,?20,"--------------------------------------"
 W !,?34,"TIME OUT VERIFIED: " W:SRTOT $J(((SRTOV/SRTOT)*100),5,1),"%"
 W !,?21,"PREOPERATIVE IMAGING CONFIRMED: " W:SRTOT $J((((SRICY+SRICNR)/SRTOT)*100),5,1),"%"
 W !,?20,"MARK ON SURGICAL SITE CONFIRMED: " W:SRTOT $J((((SRSCY+SRSCNR)/SRTOT)*100),5,1),"%"
 Q
DEM ; get patient demographic information
 D DEM^VADPT S SRSNM=VADM(1),SRSSN=VA("PID")
 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))
 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>")
 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:"")
 S SRCIRC="",Y=$O(^SRF(SRTN,19,0)) S:Y SRCIRC=$P($G(^SRF(SRTN,19,Y,0)),"^")
 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>")
PROC ; get principal procedure
 K SRPROC S X=$P(^SRF(SRTN,"OP"),"^") I $L(X)<49 S SRPROC(1)=X
 I $L(X)>48 S K=1 F  D  I $L(X)<49 S SRPROC(K)=X Q
 .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
 Q
CASE ; print case info
 D DEM D:$Y+6>IOSL PAGE Q:SRSOUT
 I $E(SRSS,1,2)="ZZ" S SRSPEC=$E(SRSS,3,40)
 W !,SRSDATE,?32,SRATT,?62,$S(SR71="Y":"YES",SR71="N":"NO",1:"<NOT ENTERED>")
 W !,SRSNM,?32,SRCIRC,?62,$S(SR72="Y":"YES",SR72="N":"NO",SR72="I":"NOT REQUIRED",1:"<NOT ENTERED>")
 W !,SRSSN_"  ("_SRAGE_")",?21,SRTN,?32,SRPROC(1),?62,$S(SR73="Y":"YES",SR73="N":"NO",SR73="M":"NOT REQUIRED",1:"<NOT ENTERED>")
 I 'SRORD W !,"("_$E(SRSPEC,1,28)_")" W:$D(SRPROC(2)) ?32,SRPROC(2)
 I SRORD W:$D(SRPROC(2)) !,?32,SRPROC(2)
 W:$D(SRPROC(3)) !,?32,SRPROC(3) W:$D(SRPROC(4)) !,?32,SRPROC(4)
 W !,SRCST,!
 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
 .I '$O(^SRF(SRTN,I,0)) W !,?2,"<NOT ENTERED>",! Q
 .S SRSJ=0 F  S SRSJ=$O(^SRF(SRTN,I,SRSJ)) Q:'SRSJ  W !,?2,$G(^SRF(SRTN,I,SRSJ,0))
 .W !
 W ! F I=1:1:80 W "-"
 Q
PAGE I $E(IOST)="P"!SRHDR G HDR
 W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
HDR ; print heading
 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
 S SRTITLE=SRRPT_" - "_SRTAG
 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
 I SRHDRL D
 .W !!,"DATE OF OPERATION",?32,"ATTENDING SURGEON",?62,"TIME OUT VERIFIED"
 .W !,"PATIENT NAME",?32,"CIRCULATING NURSE",?62,"IMAGING CONFIRMED"
 .W !,"PATIENT ID  (AGE)",?21,"CASE #",?32,"PRINCIPAL PROCEDURE",?62,"MARK SITE CONFIRM"
 .W !,"CASE SCHEDULE TYPE"
 S SRPAGE=SRPAGE+1 W ! F I=1:1:80 W "="
 I 'SRHDR,SRHDRL,SRORD D SPNAME
 S SRHDR=0
 Q