Routine: SROACMP1

SROACMP1 ;BIR/ADM - M&M VERIFICATION REPORT (CONT'D) ;11/26/07

 ;;3.0; Surgery ;**47,68,77,50,166**;24 Jun 93;Build 6

EN ; entry point

 S (SRSOUT,SRSP)=0,SRINST=$P($$SITE^SROVAR,"^",2) W @IOF,!,?28,"M&M Verification Report"

 W !!,"The M&M Verification Report is a tool to assist in the review of occurrences"

 W !,"and their assignment to operations and in the review of death unrelated or",!,"related assignments to operations."

 W !!,"The full report includes all patients who had operations within the selected"

 W !,"date range who experienced intraoperative occurrences, postoperative"

 W !,"occurrences or death within 90 days of surgery. The pre-transmission report"

 W !,"is similar but includes only operations with completed risk assessments that"

 W !,"have not yet transmitted to the national database.",!

 D SEL G:SRSOUT END I SRFORM=2 G SPEC

 D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END

SPEC I $D(^XUSEC("SROCHIEF",+DUZ)) N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))

 W !! K DIR S DIR("A")="Do you want to print this report for all Surgical Specialties ",DIR("B")="YES",DIR(0)="Y"

 S DIR("?",1)="Enter RETURN to print this report for all surgical specialties, or 'NO' to",DIR("?")="select a specific specialty."

 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END

 I 'Y D SP I SRSOUT G END

DEV K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END

 I $D(IO("Q")) K IO("Q") S ZTDESC="M&M Verification Report",ZTRTN="BEG^SROACMP1",(ZTSAVE("SRFORM"),ZTSAVE("SRINST"),ZTSAVE("SRSP*"),ZTSAVE("SRINSTP"))="" S:SRFORM=1 (ZTSAVE("SRED"),ZTSAVE("SRSD"))="" D ^%ZTLOAD G END

BEG U IO S (SRHDR,SRNM,SRSOUT,SRSS)=0,PAGE=1,Y=DT X ^DD("DD") S SRPRINT="Report Generated: "_Y K ^TMP("SR",$J),^TMP("SRPAT",$J)

 N SRFRTO I SRFORM=1 D

 .S Y=SRSD X ^DD("DD") S SRFRTO="From: "_Y S Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_"  To: "_Y

 .S SRSDT=SRSD-.0001,SREDT=SRED+.9999 F  S SRSDT=$O(^SRF("AC",SRSDT)) Q:SRSDT>SREDT!'SRSDT!SRSOUT  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN!SRSOUT  D CASE

 I SRFORM=2 F SRASS="C","N" S DFN=0 F  S DFN=$O(^SRF("ARS",SRASS,"C",DFN)) Q:'DFN!SRSOUT  S SRTN=0 F  S SRTN=$O(^SRF("ARS",SRASS,"C",DFN,SRTN)) Q:'SRTN!SRSOUT  D CASE

 G:SRSOUT END G ^SROACMP

CASE ; examine case

 Q:'$D(^SRF(SRTN,0))

 I $D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$MANDIV^SROUTL0(SRINSTP,SRTN)

 I '$D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$DIV^SROUTL0(SRTN)

 I SRFORM=2,SRSP S Y=$P(^SRF(SRTN,0),"^",4) S:'Y Y="ZZ" I '$D(SRSP(Y)) Q

 I '$P($G(^SRF(SRTN,.2)),"^",12)!$P($G(^SRF(SRTN,30)),"^")!($P($G(^SRF(SRTN,"NON")),"^")="Y") Q

 S DFN=$P(^SRF(SRTN,0),"^") I $O(^SRF(SRTN,10,0))!$O(^SRF(SRTN,16,0)) S ^TMP("SR",$J,DFN,SRTN)=$P(^SRF(SRTN,0),"^",4) Q

 S SRDEATH=$P($G(^DPT(DFN,.35)),"^") I SRDEATH S X1=$P(^SRF(SRTN,0),"^",9),X2=90 D C^%DTC S SRDAY=X I SRDEATH'>SRDAY S ^TMP("SR",$J,DFN,SRTN)=$P(^SRF(SRTN,0),"^",4)

END Q:'$D(SRSOUT)  W @IOF K ^TMP("SRPAT",$J),^TMP("SRSP",$J) I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 D ^%ZISC,^SRSKILL K SRTN W @IOF

SEL ; select report version

 K DIR S DIR("A",1)="Print which report ?",DIR("A",2)=" ",DIR("A",3)="1. Full report for selected date range.",DIR("A",4)="2. Pre-transmission report for completed risk assessments."

 S DIR("A",5)=" ",DIR("A")="Enter selection (1 or 2): ",DIR("B")=1,DIR("?")="Please enter the number (1 or 2) matching your choice of report",DIR(0)="NA^1:2" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q

 S SRFORM=Y

SP W !! S SRSP=1 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the report for which Specialty ?  " D ^DIC I Y<0 S SRSOUT=1 Q

 S SRCT=+Y,SRSP(SRCT)=+Y

MORE ; ask for more surgical specialties

 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select an Additional Specialty:  " D ^DIC I Y>0 S SRCT=+Y,SRSP(SRCT)=+Y G MORE

HDR ; print heading

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 I SRHDR D HDR2 Q:SRSOUT  S SRHDR=0

 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?124,"Page ",PAGE,!,?54,"M&M Verification Report"

 W:SRFORM=1 !,?(132-$L(SRFRTO)\2),SRFRTO

 W:SRFORM=2 !,?41,"PRE-TRANSMISSION REPORT FOR COMPLETED ASSESSMENTS"

 W ?100,"REVIEWED BY:",!,?(132-$L(SRPRINT)\2),SRPRINT,?100,"DATE REVIEWED:",!

 W !,"OP DATE",?11,"CASE #",?25,"SURGICAL SPECIALTY",?80,"ASSESSMENT TYPE   STATUS",?116,"DEATH RELATED",!,?11,"PRINCIPAL PROCEDURE",! F LINE=1:1:132 W "="

 I SRNM W !,SRNAME_"   * * Continued from previous page * *"

 S PAGE=PAGE+1,SRHDR=1 I '$D(^TMP("SR",$J))

HDR2 ; more heading

 ;I $Y+6<IOSL F I=$Y:1:IOSL-5 W !

FOOT ; print footer

 ;W ! F LINE=1:1:IOM W "-"

 ;W !,"Occurrences(s): '*' Denotes Postop Occurrence",! F LINE=1:1:IOM W "-"

 S SRHDR=0 I $E(IOST)'="P" W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S SRSOUT=1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROACMP1   4960     printed  Apr 23, 2025@18:54:49                                                                                                                                                                                                    Page 2

SROACMP1  ;BIR/ADM - M&M VERIFICATION REPORT (CONT'D) ;11/26/07

 +1       ;;3.0; Surgery ;**47,68,77,50,166**;24 Jun 93;Build 6

EN        ; entry point

 +1        SET (SRSOUT,SRSP)=0

           SET SRINST=$PIECE($$SITE^SROVAR,"^",2)

           WRITE @IOF,!,?28,"M&M Verification Report"

 +2        WRITE !!,"The M&M Verification Report is a tool to assist in the review of occurrences"

 +3        WRITE !,"and their assignment to operations and in the review of death unrelated or",!,"related assignments to operations."

 +4        WRITE !!,"The full report includes all patients who had operations within the selected"

 +5        WRITE !,"date range who experienced intraoperative occurrences, postoperative"

 +6        WRITE !,"occurrences or death within 90 days of surgery. The pre-transmission report"

 +7        WRITE !,"is similar but includes only operations with completed risk assessments that"

 +8        WRITE !,"have not yet transmitted to the national database.",!

 +9        DO SEL

           if SRSOUT

               GOTO END

           IF SRFORM=2

               GOTO SPEC

 +10       DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)

           if SRSOUT

               GOTO END

SPEC       IF $DATA(^XUSEC("SROCHIEF",+DUZ))

               NEW SRINSTP

               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))

 +1        WRITE !!

           KILL DIR

           SET DIR("A")="Do you want to print this report for all Surgical Specialties "

           SET DIR("B")="YES"

           SET DIR(0)="Y"

 +2        SET DIR("?",1)="Enter RETURN to print this report for all surgical specialties, or 'NO' to"

           SET DIR("?")="select a specific specialty."

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               GOTO END

 +4        IF 'Y

               DO SP

               IF SRSOUT

                   GOTO END

DEV        KILL IOP,%ZIS,POP,IO("Q")

           SET %ZIS("A")="Print the Report on which Device: "

           SET %ZIS="QM"

           WRITE !!,"This report is designed to use a 132 column format.",!

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

 +1        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTDESC="M&M Verification Report"

               SET ZTRTN="BEG^SROACMP1"

               SET (ZTSAVE("SRFORM"),ZTSAVE("SRINST"),ZTSAVE("SRSP*"),ZTSAVE("SRINSTP"))=""

               if SRFORM=1

                   SET (ZTSAVE("SRED"),ZTSAVE("SRSD"))=""

               DO ^%ZTLOAD

               GOTO END

BEG        USE IO

           SET (SRHDR,SRNM,SRSOUT,SRSS)=0

           SET PAGE=1

           SET Y=DT

           XECUTE ^DD("DD")

           SET SRPRINT="Report Generated: "_Y

           KILL ^TMP("SR",$JOB),^TMP("SRPAT",$JOB)

 +1        NEW SRFRTO

           IF SRFORM=1

               Begin DoDot:1

 +2                SET Y=SRSD

                   XECUTE ^DD("DD")

                   SET SRFRTO="From: "_Y

                   SET Y=SRED

                   XECUTE ^DD("DD")

                   SET SRFRTO=SRFRTO_"  To: "_Y

 +3                SET SRSDT=SRSD-.0001

                   SET SREDT=SRED+.9999

FOR

                       SET SRSDT=$ORDER(^SRF("AC",SRSDT))

                       if SRSDT>SREDT!'SRSDT!SRSOUT

                           QUIT

                       SET SRTN=0

FOR

                           SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))

                           if 'SRTN!SRSOUT

                               QUIT

                           DO CASE

               End DoDot:1

 +4        IF SRFORM=2

               FOR SRASS="C","N"

                   SET DFN=0

FOR

                       SET DFN=$ORDER(^SRF("ARS",SRASS,"C",DFN))

                       if 'DFN!SRSOUT

                           QUIT

                       SET SRTN=0

FOR

                           SET SRTN=$ORDER(^SRF("ARS",SRASS,"C",DFN,SRTN))

                           if 'SRTN!SRSOUT

                               QUIT

                           DO CASE

 +5        if SRSOUT

               GOTO END

           GOTO ^SROACMP

CASE      ; examine case

 +1        if '$DATA(^SRF(SRTN,0))

               QUIT

 +2        IF $DATA(^XUSEC("SROCHIEF",+DUZ))

               if '$$MANDIV^SROUTL0(SRINSTP,SRTN)

                   QUIT

 +3        IF '$DATA(^XUSEC("SROCHIEF",+DUZ))

               if '$$DIV^SROUTL0(SRTN)

                   QUIT

 +4        IF SRFORM=2

               IF SRSP

                   SET Y=$PIECE(^SRF(SRTN,0),"^",4)

                   if 'Y

                       SET Y="ZZ"

                   IF '$DATA(SRSP(Y))

                       QUIT

 +5        IF '$PIECE($GET(^SRF(SRTN,.2)),"^",12)!$PIECE($GET(^SRF(SRTN,30)),"^")!($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y")

               QUIT

 +6        SET DFN=$PIECE(^SRF(SRTN,0),"^")

           IF $ORDER(^SRF(SRTN,10,0))!$ORDER(^SRF(SRTN,16,0))

               SET ^TMP("SR",$JOB,DFN,SRTN)=$PIECE(^SRF(SRTN,0),"^",4)

               QUIT

 +7        SET SRDEATH=$PIECE($GET(^DPT(DFN,.35)),"^")

           IF SRDEATH

               SET X1=$PIECE(^SRF(SRTN,0),"^",9)

               SET X2=90

               DO C^%DTC

               SET SRDAY=X

               IF SRDEATH'>SRDAY

                   SET ^TMP("SR",$JOB,DFN,SRTN)=$PIECE(^SRF(SRTN,0),"^",4)

 +8        QUIT

END        if '$DATA(SRSOUT)

               QUIT

           WRITE @IOF

           KILL ^TMP("SRPAT",$JOB),^TMP("SRSP",$JOB)

           IF $DATA(ZTQUEUED)

               KILL ^TMP("SR",$JOB)

               if $GET(ZTSTOP)

                   QUIT

               SET ZTREQ="@"

               QUIT

 +1        DO ^%ZISC

           DO ^SRSKILL

           KILL SRTN

           WRITE @IOF

 +2        QUIT

SEL       ; select report version

 +1        KILL DIR

           SET DIR("A",1)="Print which report ?"

           SET DIR("A",2)=" "

           SET DIR("A",3)="1. Full report for selected date range."

           SET DIR("A",4)="2. Pre-transmission report for completed risk assessments."

 +2        SET DIR("A",5)=" "

           SET DIR("A")="Enter selection (1 or 2): "

           SET DIR("B")=1

           SET DIR("?")="Please enter the number (1 or 2) matching your choice of report"

           SET DIR(0)="NA^1:2"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               QUIT

 +3        SET SRFORM=Y

 +4        QUIT

SP         WRITE !!

           SET SRSP=1

           KILL DIC

           SET DIC("S")="I '$P(^(0),""^"",3)"

           SET DIC=137.45

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Print the report for which Specialty ?  "

           DO ^DIC

           IF Y<0

               SET SRSOUT=1

               QUIT

 +1        SET SRCT=+Y

           SET SRSP(SRCT)=+Y

MORE      ; ask for more surgical specialties

 +1        KILL DIC

           SET DIC("S")="I '$P(^(0),""^"",3)"

           SET DIC=137.45

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Select an Additional Specialty:  "

           DO ^DIC

           IF Y>0

               SET SRCT=+Y

               SET SRSP(SRCT)=+Y

               GOTO MORE

 +2        QUIT

HDR       ; print heading

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT

 +2        IF SRHDR

               DO HDR2

               if SRSOUT

                   QUIT

               SET SRHDR=0

 +3        if $Y

               WRITE @IOF

           WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,?124,"Page ",PAGE,!,?54,"M&M Verification Report"

 +4        if SRFORM=1

               WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO

 +5        if SRFORM=2

               WRITE !,?41,"PRE-TRANSMISSION REPORT FOR COMPLETED ASSESSMENTS"

 +6        WRITE ?100,"REVIEWED BY:",!,?(132-$LENGTH(SRPRINT)\2),SRPRINT,?100,"DATE REVIEWED:",!

 +7        WRITE !,"OP DATE",?11,"CASE #",?25,"SURGICAL SPECIALTY",?80,"ASSESSMENT TYPE   STATUS",?116,"DEATH RELATED",!,?11,"PRINCIPAL PROCEDURE",!

           FOR LINE=1:1:132

               WRITE "="

 +8        IF SRNM

               WRITE !,SRNAME_"   * * Continued from previous page * *"

 +9        SET PAGE=PAGE+1

           SET SRHDR=1

           IF '$DATA(^TMP("SR",$JOB))

 +10       QUIT

HDR2      ; more heading

 +1       ;I $Y+6<IOSL F I=$Y:1:IOSL-5 W !

FOOT      ; print footer

 +1       ;W ! F LINE=1:1:IOM W "-"

 +2       ;W !,"Occurrences(s): '*' Denotes Postop Occurrence",! F LINE=1:1:IOM W "-"

 +3        SET SRHDR=0

           IF $EXTRACT(IOST)'="P"

               WRITE !

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               IF 'Y

                   SET SRSOUT=1

 +4        QUIT

SROACMP1.m