- 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
- SROPECS1 ;BIR/ADM-Ensuring Correct Surgery Compliance Report, continued ; [ 06/03/04 2:10 PM ]
- +1 ;;3.0; Surgery ;**120,129**;24 Jun 9
- +2 SET (SRHDRL,SRNEW)=0
- IF SRFLG'=1
- SET SRHDRL=1
- DO HDR
- DO TMP
- +3 IF 'SRSOUT
- IF SRFLG'=2
- DO SUM
- +4 QUIT
- TMP ; print cases stored in ^TMP
- +1 IF SRORD
- SET SRSS=""
- DO NONE
- FOR
- SET SRSS=$ORDER(^TMP("SRLIST",$JOB,SRSS))
- IF SRSS=""!SRSOUT
- QUIT
- DO NEWSP
- Begin DoDot:1
- +2 SET SRSDT=""
- FOR
- SET SRSDT=$ORDER(^TMP("SRLIST",$JOB,SRSS,SRSDT))
- IF 'SRSDT!SRSOUT
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SRLIST",$JOB,SRSS,SRSDT,SRTN))
- IF 'SRTN!SRSOUT
- QUIT
- Begin DoDot:2
- +3 SET SRC=^TMP("SRLIST",$JOB,SRSS,SRSDT,SRTN)
- SET DFN=$PIECE(SRC,"^")
- SET SR71=$PIECE(SRC,"^",2)
- SET SR72=$PIECE(SRC,"^",3)
- SET SR73=$PIECE(SRC,"^",4)
- DO CASE
- End DoDot:2
- End DoDot:1
- +4 IF 'SRORD
- SET SRSDT=""
- DO NONE
- FOR
- SET SRSDT=$ORDER(^TMP("SRLIST",$JOB,SRSDT))
- IF 'SRSDT!SRSOUT
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SRLIST",$JOB,SRSDT,SRTN))
- IF 'SRTN!SRSOUT
- QUIT
- Begin DoDot:1
- +5 SET SRC=^TMP("SRLIST",$JOB,SRSDT,SRTN)
- SET DFN=$PIECE(SRC,"^")
- SET SR71=$PIECE(SRC,"^",2)
- SET SR72=$PIECE(SRC,"^",3)
- SET SRSS=$PIECE(SRC,"^",4)
- SET SR73=$PIECE(SRC,"^",5)
- +6 SET SRSPEC=SRSS
- DO CASE
- End DoDot:1
- +7 QUIT
- NEWSP SET SRSPEC=SRSS
- SET SRNEW=1
- IF $EXTRACT(SRSS,1,2)="ZZ"
- SET SRSPEC=$EXTRACT(SRSS,3,50)
- +1 IF $Y+9>IOSL
- DO PAGE
- QUIT
- SPNAME WRITE !,">>> SPECIALTY: "_SRSPEC_$SELECT('SRNEW:" (continued)",1:"")," <<<",!
- +1 SET SRNEW=0
- +2 QUIT
- NONE ; no cases to list
- +1 IF SRORD
- IF $ORDER(^TMP("SRLIST",$JOB,SRSS))=""
- DO ZERO
- QUIT
- +2 IF 'SRORD
- IF $ORDER(^TMP("SRLIST",$JOB,SRSDT))=""
- DO ZERO
- QUIT
- +3 QUIT
- ZERO WRITE !,"NO NON-COMPLIANT SURGICAL CASES WERE FOUND FOR THIS DATE RANGE."
- +1 QUIT
- SUM ; print summary
- +1 SET SRTAG="COMPLIANCE SUMMARY"
- SET SRHDRL=0
- DO PAGE
- +2 WRITE !,?42,"CASES % OF TOTAL",!,?42,"----- ----------"
- +3 WRITE !,?18,"TOTAL CASES PERFORMED:"_$JUSTIFY(SRTOT,6),?53,"100.0"
- +4 WRITE !!,?22,"TIME OUT VERIFIED",!,?36,"YES:"_$JUSTIFY(SRTOV,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRTOV/SRTOT)*100),5,1)
- +5 WRITE !,?37,"NO:"_$JUSTIFY(SRTONO,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRTONO/SRTOT)*100),5,1)
- +6 WRITE !,?28,"NOT ENTERED:"_$JUSTIFY(SRTONE,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRTONE/SRTOT)*100),5,1)
- +7 WRITE !!,?9,"PREOPERATIVE IMAGING CONFIRMED",!,?36,"YES:"_$JUSTIFY(SRICY,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRICY/SRTOT)*100),5,1)
- +8 WRITE !,?19,"IMAGING NOT REQUIRED:"_$JUSTIFY(SRICNR,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRICNR/SRTOT)*100),5,1)
- +9 WRITE !,?37,"NO:"_$JUSTIFY(SRICNO,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRICNO/SRTOT)*100),5,1)
- +10 WRITE !,?28,"NOT ENTERED:"_$JUSTIFY(SRICNE,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRICNE/SRTOT)*100),5,1)
- +11 WRITE !!,?8,"MARK ON SURGICAL SITE CONFIRMED",!,?36,"YES:"_$JUSTIFY(SRSCY,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRSCY/SRTOT)*100),5,1)
- +12 WRITE !,?19,"MARKING NOT REQUIRED:"_$JUSTIFY(SRSCNR,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRSCNR/SRTOT)*100),5,1)
- +13 WRITE !,?37,"NO:"_$JUSTIFY(SRSCNO,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRSCNO/SRTOT)*100),5,1)
- +14 WRITE !,?28,"NOT ENTERED:"_$JUSTIFY(SRSCNE,6)
- IF SRTOT
- WRITE ?53,$JUSTIFY(((SRSCNE/SRTOT)*100),5,1)
- +15 WRITE !!,?20,"OVERALL COMPLIANCE FOR THIS DATE RANGE",!,?20,"--------------------------------------"
- +16 WRITE !,?34,"TIME OUT VERIFIED: "
- IF SRTOT
- WRITE $JUSTIFY(((SRTOV/SRTOT)*100),5,1),"%"
- +17 WRITE !,?21,"PREOPERATIVE IMAGING CONFIRMED: "
- IF SRTOT
- WRITE $JUSTIFY((((SRICY+SRICNR)/SRTOT)*100),5,1),"%"
- +18 WRITE !,?20,"MARK ON SURGICAL SITE CONFIRMED: "
- IF SRTOT
- WRITE $JUSTIFY((((SRSCY+SRSCNR)/SRTOT)*100),5,1),"%"
- +19 QUIT
- DEM ; get patient demographic information
- +1 DO DEM^VADPT
- SET SRSNM=VADM(1)
- SET SRSSN=VA("PID")
- +2 SET Y=SRSDT
- XECUTE ^DD("DD")
- SET SRSDATE=Y
- SET X1=$EXTRACT(SRSDT,1,7)
- SET X2=$PIECE(VADM(3),"^")
- SET SRAGE=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
- +3 SET Y=$PIECE($GET(^SRF(SRTN,.1)),"^",13)
- SET C=$PIECE(^DD(130,.164,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SRATT=$SELECT(Y'="":$EXTRACT(Y,1,29),1:"<NOT ENTERED>")
- +4 SET SRCST=""
- SET Y=$PIECE(^SRF(SRTN,0),"^",10)
- IF Y'=""
- SET SRCST=$SELECT(Y="EM":"EMERGENCY",Y="EL":"ELECTIVE",Y="A":"ADD ON (NON-EMERGENT)",Y="S":"STANDBY",Y="U":"URGENT",1:"")
- +5 SET SRCIRC=""
- SET Y=$ORDER(^SRF(SRTN,19,0))
- IF Y
- SET SRCIRC=$PIECE($GET(^SRF(SRTN,19,Y,0)),"^")
- +6 SET Y=SRCIRC
- SET C=$PIECE(^DD(130.28,.01,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SRCIRC=$SELECT(Y'="":$EXTRACT(Y,1,29),1:"<NOT ENTERED>")
- PROC ; get principal procedure
- +1 KILL SRPROC
- SET X=$PIECE(^SRF(SRTN,"OP"),"^")
- IF $LENGTH(X)<49
- SET SRPROC(1)=X
- +2 IF $LENGTH(X)>48
- SET K=1
- FOR
- Begin DoDot:1
- +3 FOR I=0:1:47
- SET J=48-I
- SET Y=$EXTRACT(X,J)
- IF Y=" "
- SET SRPROC(K)=$EXTRACT(X,1,J-1)
- SET X=$EXTRACT(X,J+1,$LENGTH(X))
- SET K=K+1
- QUIT
- End DoDot:1
- IF $LENGTH(X)<49
- SET SRPROC(K)=X
- QUIT
- +4 QUIT
- CASE ; print case info
- +1 DO DEM
- IF $Y+6>IOSL
- DO PAGE
- IF SRSOUT
- QUIT
- +2 IF $EXTRACT(SRSS,1,2)="ZZ"
- SET SRSPEC=$EXTRACT(SRSS,3,40)
- +3 WRITE !,SRSDATE,?32,SRATT,?62,$SELECT(SR71="Y":"YES",SR71="N":"NO",1:"<NOT ENTERED>")
- +4 WRITE !,SRSNM,?32,SRCIRC,?62,$SELECT(SR72="Y":"YES",SR72="N":"NO",SR72="I":"NOT REQUIRED",1:"<NOT ENTERED>")
- +5 WRITE !,SRSSN_" ("_SRAGE_")",?21,SRTN,?32,SRPROC(1),?62,$SELECT(SR73="Y":"YES",SR73="N":"NO",SR73="M":"NOT REQUIRED",1:"<NOT ENTERED>")
- +6 IF 'SRORD
- WRITE !,"("_$EXTRACT(SRSPEC,1,28)_")"
- IF $DATA(SRPROC(2))
- WRITE ?32,SRPROC(2)
- +7 IF SRORD
- IF $DATA(SRPROC(2))
- WRITE !,?32,SRPROC(2)
- +8 IF $DATA(SRPROC(3))
- WRITE !,?32,SRPROC(3)
- IF $DATA(SRPROC(4))
- WRITE !,?32,SRPROC(4)
- +9 WRITE !,SRCST,!
- +10 FOR I=82,83,84
- WRITE !,$SELECT(I=82:"TIME OUT VERIFY COMMENTS:",I=83:"PREOPERATIVE IMAGING CONFIRMED COMMENTS:",1:"MARKED SITE CONFIRMED COMMENTS:")
- Begin DoDot:1
- +11 IF '$ORDER(^SRF(SRTN,I,0))
- WRITE !,?2,"<NOT ENTERED>",!
- QUIT
- +12 SET SRSJ=0
- FOR
- SET SRSJ=$ORDER(^SRF(SRTN,I,SRSJ))
- IF 'SRSJ
- QUIT
- WRITE !,?2,$GET(^SRF(SRTN,I,SRSJ,0))
- +13 WRITE !
- End DoDot:1
- +14 WRITE !
- FOR I=1:1:80
- WRITE "-"
- +15 QUIT
- PAGE IF $EXTRACT(IOST)="P"!SRHDR
- GOTO HDR
- +1 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 SET SRTITLE=SRRPT_" - "_SRTAG
- +3 IF $Y
- WRITE @IOF
- IF $EXTRACT(IOST)="P"
- WRITE !,?(80-$LENGTH(SRINST)\2),SRINST
- WRITE !,?(80-$LENGTH(SRTITLE)\2),SRTITLE,?70,$JUSTIFY("PAGE "_SRPAGE,9),!,?(80-$LENGTH(SRFRTO)\2),SRFRTO
- IF $EXTRACT(IOST)="P"
- WRITE !,?(80-$LENGTH(SRPRINT)\2),SRPRINT
- +4 IF SRHDRL
- Begin DoDot:1
- +5 WRITE !!,"DATE OF OPERATION",?32,"ATTENDING SURGEON",?62,"TIME OUT VERIFIED"
- +6 WRITE !,"PATIENT NAME",?32,"CIRCULATING NURSE",?62,"IMAGING CONFIRMED"
- +7 WRITE !,"PATIENT ID (AGE)",?21,"CASE #",?32,"PRINCIPAL PROCEDURE",?62,"MARK SITE CONFIRM"
- +8 WRITE !,"CASE SCHEDULE TYPE"
- End DoDot:1
- +9 SET SRPAGE=SRPAGE+1
- WRITE !
- FOR I=1:1:80
- WRITE "="
- +10 IF 'SRHDR
- IF SRHDRL
- IF SRORD
- DO SPNAME
- +11 SET SRHDR=0
- +12 QUIT
