SROPECS ;BIR/ADM-Ensuring Correct Surgery Compliance Report ; [ 07/03/03 11:39 AM ]
;;3.0; Surgery ;**120,126,129**;24 Jun 93
W @IOF,!,?18,"Ensuring Correct Surgery Compliance Report"
W !!,?2,"This two-part report includes a summary of the rate of compliance and/or a",!,?2,"list of surgical cases that are non-compliant in documenting the process"
W !,?2,"for ensuring correct surgery for operations performed by the selected",!,?2,"surgical specialties during the selected date range.",!
N SRFRTO,SRINSTP,SRORD,SRRPT S (SRORD,SRSOUT,SRSP)=0
ASK W ! K DIR S DIR("A",1)="Print which part of the report?",DIR("A",2)="",DIR("A",3)="1. Compliance Summary Only",DIR("A",4)="2. List of Non-Compliant Cases",DIR("A",5)="3. Both Parts",DIR("A",6)=""
S DIR("A")="Select Number (1, 2 or 3): ",DIR("B")="3"
S DIR(0)="NA^1:3:0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
S SRFLG=Y W " "_$S(Y=1:"Compliance Summary Only",Y=2:"List of Non-Compliant Cases",1:"Both Parts")
DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END
D SORT G:SRSOUT END
S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
DEVICE W ! K %ZIS,IOP,IO("Q"),POP S %ZIS("A")="Print the report on which Printer ? ",%ZIS="Q",%ZIS("B")="" D ^%ZIS I POP S SRSOUT=1 G END
I $D(IO("Q")) K IO("Q") D D ^%ZTLOAD S SRSOUT=1 G END
.S ZTDESC="ENSURING CORRECT SURGERY REPORT",ZTRTN="EN^SROPECS"
.S (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRFLG"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRORD"),ZTSAVE("SRSP*"))=""
EN ; entry point when queued
U IO S SRSOUT=0,(SRHDR,SRPAGE)=1,SRSDT=SDATE-.0001,SRSEDT=EDATE+.9999,Y=SDATE X ^DD("DD") S STARTDT=Y,Y=EDATE X ^DD("DD") S ENDATE=Y
S SRRPT="ENSURING CORRECT SURGERY",SRFRTO="FROM: "_STARTDT_" TO: "_ENDATE
D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S SRPRINT="REPORT PRINTED: "_Y
N SR0,SR71,SR72,SR73,SRCIRC,SRHDRL,SRICNE,SRICNO,SRICY,SRICNR,SRTAG,SRTONE,SRTONO,SRTOT,SRTOV,SRVER,SRSCY,SRSCNR,SRSCNO,SRSCNE
S SRTAG=$S(SRFLG'=1:"LIST OF NON-COMPLIANT CASES",1:"COMPLIANCE SUMMARY")
I SRFLG'=1 K ^TMP("SRLIST",$J)
S (SRTOT,SRTOV,SRTONO,SRTONE,SRICY,SRICNO,SRICNR,SRICNE,SRSCY,SRSCNR,SRSCNO,SRSCNE)=0
F S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT!(SRSDT>SRSEDT)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN),$P($G(^SRF(SRTN,30)),"^")="" D UTIL
D ^SROPECS1
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
I 'SRSOUT,$E(IOST)'="P" W ! K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR
D ^%ZISC,^SRSKILL K SRTN,^TMP("SRLIST",$J) W @IOF
Q
UTIL ; process case
Q:$P($G(^SRF(SRTN,.2)),"^",12)=""!($P($G(^SRF(SRTN,"NON")),"^")="Y")
S SR0=$G(^SRF(SRTN,0)) S SRSS=$P(SR0,"^",4) S:SRSS="" SRSS="ZZ" I SRORD,'SRSP,'$D(SRSP(SRSS)) Q
S SRVER=$G(^SRF(SRTN,"VER")) D TOV,IC,MRK S SRTOT=SRTOT+1 Q:SRFLG=1
I SR71="Y",(SR72="Y"!(SR72="I")),(SR73="Y"!(SR73="M")) Q
S Y=$S(SRSS="ZZ":"",1:SRSS),C=$P(^DD(130,.04,0),"^",2) D:Y'="" Y^DIQ S SRSS=$S(Y'="":Y,1:"ZZSPECIALTY NOT ENTERED")
I SRORD S ^TMP("SRLIST",$J,SRSS,SRSDT,SRTN)=$P(SR0,"^")_"^"_SR71_"^"_SR72_"^"_SR73 Q
S ^TMP("SRLIST",$J,SRSDT,SRTN)=$P(SR0,"^")_"^"_SR71_"^"_SR72_"^"_SRSS_"^"_SR73
Q
TOV ; process time out verified field
S SR71=$P(SRVER,"^",3) I SR71="Y" S SRTOV=SRTOV+1 Q
I SR71="N" S SRTONO=SRTONO+1 Q
S SRTONE=SRTONE+1
Q
IC ; process preoperative imaging confirmed field
S SR72=$P(SRVER,"^",4) I SR72="Y" S SRICY=SRICY+1 Q
I SR72="I" S SRICNR=SRICNR+1 Q
I SR72="N" S SRICNO=SRICNO+1 Q
S SRICNE=SRICNE+1
Q
MRK ; process mark on surgical site confirmed field
S SR73=$P(SRVER,"^",5) I SR73="Y" S SRSCY=SRSCY+1 Q
I SR73="M" S SRSCNR=SRSCNR+1 Q
I SR73="N" S SRSCNO=SRSCNO+1 Q
S SRSCNE=SRSCNE+1
Q
SORT I SRFLG=1 S SRORD=1 D SPEC Q
W ! S DIR("?",1)="Press the ENTER key to sort the report by surgical specialty or enter NO",DIR("?")="to not sort by surgical specialty."
S DIR("A")="Print the List of Non-Compliant Cases sorted by Surgical Specialty ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
S SRORD=Y Q:'Y
SPEC W ! S DIR("?",1)="Enter YES if you would like the report printed for all Surgical Specialties",DIR("?")="or enter NO to select a single specialty."
S DIR("A")="Print the report for all Surgical Specialties ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
S SRSP=Y Q:Y
SP W ! S DIR("A")="Print the report for which Specialty ? ",DIR(0)="130,.04A" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
S SRSP(+Y)=+Y
MORE ; asK for more surgical specialties
W ! S DIR("A")="Select an additional Specialty: ",DIR(0)="130,.04AO" D ^DIR K DIR I $D(DTOUT) S SRSOUT=1 Q
Q:'+Y S SRSP(+Y)=+Y G MORE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPECS 4802 printed Sep 23, 2025@20:21:27 Page 2
SROPECS ;BIR/ADM-Ensuring Correct Surgery Compliance Report ; [ 07/03/03 11:39 AM ]
+1 ;;3.0; Surgery ;**120,126,129**;24 Jun 93
+2 WRITE @IOF,!,?18,"Ensuring Correct Surgery Compliance Report"
+3 WRITE !!,?2,"This two-part report includes a summary of the rate of compliance and/or a",!,?2,"list of surgical cases that are non-compliant in documenting the process"
+4 WRITE !,?2,"for ensuring correct surgery for operations performed by the selected",!,?2,"surgical specialties during the selected date range.",!
+5 NEW SRFRTO,SRINSTP,SRORD,SRRPT
SET (SRORD,SRSOUT,SRSP)=0
ASK WRITE !
KILL DIR
SET DIR("A",1)="Print which part of the report?"
SET DIR("A",2)=""
SET DIR("A",3)="1. Compliance Summary Only"
SET DIR("A",4)="2. List of Non-Compliant Cases"
SET DIR("A",5)="3. Both Parts"
SET DIR("A",6)=""
+1 SET DIR("A")="Select Number (1, 2 or 3): "
SET DIR("B")="3"
+2 SET DIR(0)="NA^1:3:0"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO END
+3 SET SRFLG=Y
WRITE " "_$SELECT(Y=1:"Compliance Summary Only",Y=2:"List of Non-Compliant Cases",1:"Both Parts")
DATE DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)
if SRSOUT
GOTO END
+1 DO SORT
if SRSOUT
GOTO END
+2 SET SRINST=$$INST^SROUTL0()
if SRINST="^"
GOTO END
SET SRINSTP=$PIECE(SRINST,U)
SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,U,2))
DEVICE WRITE !
KILL %ZIS,IOP,IO("Q"),POP
SET %ZIS("A")="Print the report on which Printer ? "
SET %ZIS="Q"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+1 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+2 SET ZTDESC="ENSURING CORRECT SURGERY REPORT"
SET ZTRTN="EN^SROPECS"
+3 SET (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRFLG"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRORD"),ZTSAVE("SRSP*"))=""
End DoDot:1
DO ^%ZTLOAD
SET SRSOUT=1
GOTO END
EN ; entry point when queued
+1 USE IO
SET SRSOUT=0
SET (SRHDR,SRPAGE)=1
SET SRSDT=SDATE-.0001
SET SRSEDT=EDATE+.9999
SET Y=SDATE
XECUTE ^DD("DD")
SET STARTDT=Y
SET Y=EDATE
XECUTE ^DD("DD")
SET ENDATE=Y
+2 SET SRRPT="ENSURING CORRECT SURGERY"
SET SRFRTO="FROM: "_STARTDT_" TO: "_ENDATE
+3 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
SET SRPRINT="REPORT PRINTED: "_Y
+4 NEW SR0,SR71,SR72,SR73,SRCIRC,SRHDRL,SRICNE,SRICNO,SRICY,SRICNR,SRTAG,SRTONE,SRTONO,SRTOT,SRTOV,SRVER,SRSCY,SRSCNR,SRSCNO,SRSCNE
+5 SET SRTAG=$SELECT(SRFLG'=1:"LIST OF NON-COMPLIANT CASES",1:"COMPLIANCE SUMMARY")
+6 IF SRFLG'=1
KILL ^TMP("SRLIST",$JOB)
+7 SET (SRTOT,SRTOV,SRTONO,SRTONE,SRICY,SRICNO,SRICNR,SRICNE,SRSCY,SRSCNR,SRSCNO,SRSCNE)=0
+8 FOR
SET SRSDT=$ORDER(^SRF("AC",SRSDT))
if 'SRSDT!(SRSDT>SRSEDT)!SRSOUT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))
if 'SRTN
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
IF $PIECE($GET(^SRF(SRTN,30)),"^")=""
DO UTIL
+9 DO ^SROPECS1
END if $EXTRACT(IOST)="P"
WRITE @IOF
IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 IF 'SRSOUT
IF $EXTRACT(IOST)'="P"
WRITE !
KILL DIR
SET DIR("A")="Press RETURN to continue "
SET DIR(0)="FOA"
DO ^DIR
KILL DIR
+2 DO ^%ZISC
DO ^SRSKILL
KILL SRTN,^TMP("SRLIST",$JOB)
WRITE @IOF
+3 QUIT
UTIL ; process case
+1 if $PIECE($GET(^SRF(SRTN,.2)),"^",12)=""!($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y")
QUIT
+2 SET SR0=$GET(^SRF(SRTN,0))
SET SRSS=$PIECE(SR0,"^",4)
if SRSS=""
SET SRSS="ZZ"
IF SRORD
IF 'SRSP
IF '$DATA(SRSP(SRSS))
QUIT
+3 SET SRVER=$GET(^SRF(SRTN,"VER"))
DO TOV
DO IC
DO MRK
SET SRTOT=SRTOT+1
if SRFLG=1
QUIT
+4 IF SR71="Y"
IF (SR72="Y"!(SR72="I"))
IF (SR73="Y"!(SR73="M"))
QUIT
+5 SET Y=$SELECT(SRSS="ZZ":"",1:SRSS)
SET C=$PIECE(^DD(130,.04,0),"^",2)
if Y'=""
DO Y^DIQ
SET SRSS=$SELECT(Y'="":Y,1:"ZZSPECIALTY NOT ENTERED")
+6 IF SRORD
SET ^TMP("SRLIST",$JOB,SRSS,SRSDT,SRTN)=$PIECE(SR0,"^")_"^"_SR71_"^"_SR72_"^"_SR73
QUIT
+7 SET ^TMP("SRLIST",$JOB,SRSDT,SRTN)=$PIECE(SR0,"^")_"^"_SR71_"^"_SR72_"^"_SRSS_"^"_SR73
+8 QUIT
TOV ; process time out verified field
+1 SET SR71=$PIECE(SRVER,"^",3)
IF SR71="Y"
SET SRTOV=SRTOV+1
QUIT
+2 IF SR71="N"
SET SRTONO=SRTONO+1
QUIT
+3 SET SRTONE=SRTONE+1
+4 QUIT
IC ; process preoperative imaging confirmed field
+1 SET SR72=$PIECE(SRVER,"^",4)
IF SR72="Y"
SET SRICY=SRICY+1
QUIT
+2 IF SR72="I"
SET SRICNR=SRICNR+1
QUIT
+3 IF SR72="N"
SET SRICNO=SRICNO+1
QUIT
+4 SET SRICNE=SRICNE+1
+5 QUIT
MRK ; process mark on surgical site confirmed field
+1 SET SR73=$PIECE(SRVER,"^",5)
IF SR73="Y"
SET SRSCY=SRSCY+1
QUIT
+2 IF SR73="M"
SET SRSCNR=SRSCNR+1
QUIT
+3 IF SR73="N"
SET SRSCNO=SRSCNO+1
QUIT
+4 SET SRSCNE=SRSCNE+1
+5 QUIT
SORT IF SRFLG=1
SET SRORD=1
DO SPEC
QUIT
+1 WRITE !
SET DIR("?",1)="Press the ENTER key to sort the report by surgical specialty or enter NO"
SET DIR("?")="to not sort by surgical specialty."
+2 SET DIR("A")="Print the List of Non-Compliant Cases sorted by Surgical Specialty ? "
SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 SET SRORD=Y
if 'Y
QUIT
SPEC WRITE !
SET DIR("?",1)="Enter YES if you would like the report printed for all Surgical Specialties"
SET DIR("?")="or enter NO to select a single specialty."
+1 SET DIR("A")="Print the report for all Surgical Specialties ? "
SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+2 SET SRSP=Y
if Y
QUIT
SP WRITE !
SET DIR("A")="Print the report for which Specialty ? "
SET DIR(0)="130,.04A"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+1 SET SRSP(+Y)=+Y
MORE ; asK for more surgical specialties
+1 WRITE !
SET DIR("A")="Select an additional Specialty: "
SET DIR(0)="130,.04AO"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
SET SRSOUT=1
QUIT
+2 if '+Y
QUIT
SET SRSP(+Y)=+Y
GOTO MORE
+3 QUIT
