SROQD ;BIR/ADM - CASES WITH DEATHS WITHIN 30 DAYS ;07/07/2011
;;3.0;Surgery;**62,77,50,142,176**;24 Jun 93;Build 8
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
S SRSOUT=0,SRIO="A",SRSPEC="" W @IOF,!,?24,"Deaths Within 30 Days of Surgery"
W !!,"This report lists patients who had surgery within the selected date range",!,"and who died within 30 days of surgery."
D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END
SEC W !! K DIR S DIR("A",1)="Print which report?",DIR("A",2)="",DIR("A",3)=" 1. Total Cases Summary",DIR("A",4)=" 2. National Specialty Procedures",DIR("A",5)=""
S DIR("A")="Select number: ",DIR("B")=1,DIR(0)="SAM^1:Total Cases Summary;2:Specialty Procedures" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
S SRSEL=Y D:SRSEL=2 SPEC
I SRSEL=1 W @IOF S SRRPT="Deaths within 30 Days of Surgery" D INOUT^SROUTL
N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,"^"),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,"^",2))
I SRSOUT G END
IO W !!,"This report is designed to use a 132 column format.",!
K %ZIS,IOP,IO("Q"),POP S %ZIS("A")="Print the report to which Printer ? ",%ZIS("B")="",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTDESC="Deaths within 30 Days of Surgery",(ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRIO"),ZTSAVE("SRSEL"),ZTSAVE("SRINSTP"),ZTSAVE("SRSPEC*"))="",ZTRTN="EN^SROQD" D ^%ZTLOAD S SRSOUT=1 G END
EN U IO S (SRCTOT,SRDTOT,SRHDR2,SRSNM,SRSOUT)=0,(SRHDR,SRPAGE)=1,SRSD=SDATE-.0001,SRED=EDATE+.9999,Y=SDATE X ^DD("DD") S STARTDT=Y,Y=EDATE X ^DD("DD") S ENDATE=Y
D KTMP S SRRPT="DEATHS WITHIN 30 DAYS OF SURGERY"_$S(SRSEL=2:" LISTED FOR SPECIALTY PROCEDURES",1:"")
S SRFRTO="FOR "_$S(SRIO="O":"OUTPATIENT ",SRIO="I":"INPATIENT ",1:"")_"SURGERY PERFORMED FROM: "_STARTDT_" TO: "_ENDATE
S SRINST=$S(SRINSTP["ALL DIV":$P($$SITE^SROVAR,"^",2)_" - ALL DIVISIONS",1:$$GET1^DIQ(4,SRINSTP,.01))
D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S SRPRINT="Report Printed: "_Y
D AC^SROQD0 D:SRSEL=1 PLIST D:SRSEL=2 NAT^SROQD1
END W:$E(IOST)="P" @IOF D KTMP I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
I 'SRSOUT,$E(IOST)'="P" D PRESS
D ^%ZISC K SRCTOT,SRDNAT,SRDTH,SRDTOT,SRFRTO,SRHDR2,SRINV,SRIO,SRIOSTAT,SRNAT,SRNATNM,SRRPT,SRSEL,SRTN D ^SRSKILL W @IOF
Q
PRESS W !! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
KTMP F I="SR","SRDEATH","SRDTH","SRINOUT","SRIP","SRIOST","SRNM","SRPAT","SRNAT","SRSEC","SRREL","SRTN" K ^TMP(I,$J)
Q
PLIST ; print patient list for total cases
D HDR^SROQD0 S SRNM="" I SRIO'="A" D NOTA,TOT Q
F S SRNM=$O(^TMP("SRPAT",$J,SRNM)) Q:SRNM=""!SRSOUT S DFN=0 F S DFN=$O(^TMP("SRPAT",$J,SRNM,DFN)) Q:'DFN!SRSOUT S SRZ=^(DFN) D
.S SRSNM=0,SRSSN=$P(SRZ,"^"),(SRDD,X1)=$P(SRZ,"^",3),X2=$P(SRZ,"^",2),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7)) D PAT
TOT I 'SRSOUT S SRHDR2=1 D SUM^SROQD0
Q
NOTA ; print in or out-patient deaths
F S SRNM=$O(^TMP("SRSEC",$J,SRIO,SRNM)) Q:SRNM=""!SRSOUT S DFN=0 F S DFN=$O(^TMP("SRSEC",$J,SRIO,SRNM,DFN)) Q:'DFN!SRSOUT S SRTN=^TMP("SRSEC",$J,SRIO,SRNM,DFN),SRZ=^TMP("SRPAT",$J,SRNM,DFN) D
.S SRSSN=$P(SRZ,"^"),(SRDD,X1)=$P(SRZ,"^",3),X2=$P(SRZ,"^",2),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
.S SRNAME=">>> "_SRNM_" ("_SRSSN_") - DIED "_$E(SRDD,4,5)_"/"_$E(SRDD,6,7)_"/"_$E(SRDD,2,3)_" AGE: "_SRAGE,SRDTOT=SRDTOT+1
.D:$Y+9>IOSL PAGE^SROQD0 Q:SRSOUT W !,SRNAME,! S SRSNM=1
.S SRSD=$P(^SRF(SRTN,0),"^",9),SRZ=^TMP("SR",$J,DFN,SRSD,SRTN) D OP S SRSNM=0 W ! F I=1:1:IOM W "-"
Q
PAT ; print new patient information
S SRNAME=">>> "_SRNM_" ("_SRSSN_") - DIED "_$E(SRDD,4,5)_"/"_$E(SRDD,6,7)_"/"_$E(SRDD,2,3)_" AGE: "_SRAGE,SRDTOT=SRDTOT+1
D:$Y+9>IOSL PAGE^SROQD0 Q:SRSOUT W !,SRNAME,! S SRSNM=1,SRSD=0 F S SRSD=$O(^TMP("SR",$J,DFN,SRSD)) Q:'SRSD S SRTN=0 F S SRTN=$O(^TMP("SR",$J,DFN,SRSD,SRTN)) Q:'SRTN!SRSOUT D OP
S SRSNM=0 W ! F I=1:1:IOM W "-"
Q
OP ; print case information
Q:SRSD<(SDATE-.0001)!(SRSD>(EDATE+.9999)) D:$Y+7>IOSL PAGE^SROQD0 Q:SRSOUT
S SRZ=^TMP("SR",$J,DFN,SRSD,SRTN),Y=SRSD,SRSDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),Y=$P(SRZ,"^"),SRSS=$S(Y=9999:"SPECIALTY NOT ENTERED",1:$P(^SRO(137.45,Y,0),"^"))
S Y=$P(SRZ,"^",2),SRIOSTAT=$S(Y="I":"INPAT",Y="O":"OUTPAT",1:"???"),Y=$P(SRZ,"^",3),SRREL=$S(Y="U":"UNRELATED",Y="R":"RELATED",1:"???")
S SRCON=$P(SRZ,"^",4) S SRL=52,SRSUPCPT=1 D PROC^SROUTL
W !,SRSDATE,?10,SRTN,?22,SRIOSTAT,?31,$E(SRSS,1,35),?69,SRPROC(1),?123,SRREL,! W:SRCON "*** CONCURRENT CASE #"_SRCON_" ***" S I=1 F S I=$O(SRPROC(I)) Q:'I W ?69,SRPROC(I),!
I SRCON,'$D(SRPROC(2)) W !
Q
SPEC ; select national specialty
W @IOF,! S DIR("?",1)="Enter YES if you would like the report printed for all National Surgical",DIR("?")="Specialties or enter NO to select a specific specialty."
S DIR("A")="Do you want the report for all National Surgical Specialties ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I 'Y W ! K DIC S DIC=45.3,DIC(0)="QEAMZ",DIC("A")="Select National Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0 S SRSPEC=+Y,SRSPECN=$P(Y(0),"^")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROQD 5261 printed Dec 13, 2024@02:45:27 Page 2
SROQD ;BIR/ADM - CASES WITH DEATHS WITHIN 30 DAYS ;07/07/2011
+1 ;;3.0;Surgery;**62,77,50,142,176**;24 Jun 93;Build 8
+2 ;** NOTICE: This routine is part of an implementation of a nationally
+3 ;** controlled procedure. Local modifications to this routine
+4 ;** are prohibited.
+5 ;
+6 SET SRSOUT=0
SET SRIO="A"
SET SRSPEC=""
WRITE @IOF,!,?24,"Deaths Within 30 Days of Surgery"
+7 WRITE !!,"This report lists patients who had surgery within the selected date range",!,"and who died within 30 days of surgery."
+8 DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)
if SRSOUT
GOTO END
SEC WRITE !!
KILL DIR
SET DIR("A",1)="Print which report?"
SET DIR("A",2)=""
SET DIR("A",3)=" 1. Total Cases Summary"
SET DIR("A",4)=" 2. National Specialty Procedures"
SET DIR("A",5)=""
+1 SET DIR("A")="Select number: "
SET DIR("B")=1
SET DIR(0)="SAM^1:Total Cases Summary;2:Specialty Procedures"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO END
+2 SET SRSEL=Y
if SRSEL=2
DO SPEC
+3 IF SRSEL=1
WRITE @IOF
SET SRRPT="Deaths within 30 Days of Surgery"
DO INOUT^SROUTL
+4 NEW SRINSTP
SET SRINST=$$INST^SROUTL0()
if SRINST="^"
GOTO END
SET SRINSTP=$PIECE(SRINST,"^")
SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,"^",2))
+5 IF SRSOUT
GOTO END
IO WRITE !!,"This report is designed to use a 132 column format.",!
+1 KILL %ZIS,IOP,IO("Q"),POP
SET %ZIS("A")="Print the report to which Printer ? "
SET %ZIS("B")=""
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Deaths within 30 Days of Surgery"
SET (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRIO"),ZTSAVE("SRSEL"),ZTSAVE("SRINSTP"),ZTSAVE("SRSPEC*"))=""
SET ZTRTN="EN^SROQD"
DO ^%ZTLOAD
SET SRSOUT=1
GOTO END
EN USE IO
SET (SRCTOT,SRDTOT,SRHDR2,SRSNM,SRSOUT)=0
SET (SRHDR,SRPAGE)=1
SET SRSD=SDATE-.0001
SET SRED=EDATE+.9999
SET Y=SDATE
XECUTE ^DD("DD")
SET STARTDT=Y
SET Y=EDATE
XECUTE ^DD("DD")
SET ENDATE=Y
+1 DO KTMP
SET SRRPT="DEATHS WITHIN 30 DAYS OF SURGERY"_$SELECT(SRSEL=2:" LISTED FOR SPECIALTY PROCEDURES",1:"")
+2 SET SRFRTO="FOR "_$SELECT(SRIO="O":"OUTPATIENT ",SRIO="I":"INPATIENT ",1:"")_"SURGERY PERFORMED FROM: "_STARTDT_" TO: "_ENDATE
+3 SET SRINST=$SELECT(SRINSTP["ALL DIV":$PIECE($$SITE^SROVAR,"^",2)_" - ALL DIVISIONS",1:$$GET1^DIQ(4,SRINSTP,.01))
+4 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
SET SRPRINT="Report Printed: "_Y
+5 DO AC^SROQD0
if SRSEL=1
DO PLIST
if SRSEL=2
DO NAT^SROQD1
END if $EXTRACT(IOST)="P"
WRITE @IOF
DO KTMP
IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 IF 'SRSOUT
IF $EXTRACT(IOST)'="P"
DO PRESS
+2 DO ^%ZISC
KILL SRCTOT,SRDNAT,SRDTH,SRDTOT,SRFRTO,SRHDR2,SRINV,SRIO,SRIOSTAT,SRNAT,SRNATNM,SRRPT,SRSEL,SRTN
DO ^SRSKILL
WRITE @IOF
+3 QUIT
PRESS WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
KTMP FOR I="SR","SRDEATH","SRDTH","SRINOUT","SRIP","SRIOST","SRNM","SRPAT","SRNAT","SRSEC","SRREL","SRTN"
KILL ^TMP(I,$JOB)
+1 QUIT
PLIST ; print patient list for total cases
+1 DO HDR^SROQD0
SET SRNM=""
IF SRIO'="A"
DO NOTA
DO TOT
QUIT
+2 FOR
SET SRNM=$ORDER(^TMP("SRPAT",$JOB,SRNM))
if SRNM=""!SRSOUT
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SRPAT",$JOB,SRNM,DFN))
if 'DFN!SRSOUT
QUIT
SET SRZ=^(DFN)
Begin DoDot:1
+3 SET SRSNM=0
SET SRSSN=$PIECE(SRZ,"^")
SET (SRDD,X1)=$PIECE(SRZ,"^",3)
SET X2=$PIECE(SRZ,"^",2)
SET SRAGE=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
DO PAT
End DoDot:1
TOT IF 'SRSOUT
SET SRHDR2=1
DO SUM^SROQD0
+1 QUIT
NOTA ; print in or out-patient deaths
+1 FOR
SET SRNM=$ORDER(^TMP("SRSEC",$JOB,SRIO,SRNM))
if SRNM=""!SRSOUT
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SRSEC",$JOB,SRIO,SRNM,DFN))
if 'DFN!SRSOUT
QUIT
SET SRTN=^TMP("SRSEC",$JOB,SRIO,SRNM,DFN)
SET SRZ=^TMP("SRPAT",$JOB,SRNM,DFN)
Begin DoDot:1
+2 SET SRSSN=$PIECE(SRZ,"^")
SET (SRDD,X1)=$PIECE(SRZ,"^",3)
SET X2=$PIECE(SRZ,"^",2)
SET SRAGE=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
+3 SET SRNAME=">>> "_SRNM_" ("_SRSSN_") - DIED "_$EXTRACT(SRDD,4,5)_"/"_$EXTRACT(SRDD,6,7)_"/"_$EXTRACT(SRDD,2,3)_" AGE: "_SRAGE
SET SRDTOT=SRDTOT+1
+4 if $Y+9>IOSL
DO PAGE^SROQD0
if SRSOUT
QUIT
WRITE !,SRNAME,!
SET SRSNM=1
+5 SET SRSD=$PIECE(^SRF(SRTN,0),"^",9)
SET SRZ=^TMP("SR",$JOB,DFN,SRSD,SRTN)
DO OP
SET SRSNM=0
WRITE !
FOR I=1:1:IOM
WRITE "-"
End DoDot:1
+6 QUIT
PAT ; print new patient information
+1 SET SRNAME=">>> "_SRNM_" ("_SRSSN_") - DIED "_$EXTRACT(SRDD,4,5)_"/"_$EXTRACT(SRDD,6,7)_"/"_$EXTRACT(SRDD,2,3)_" AGE: "_SRAGE
SET SRDTOT=SRDTOT+1
+2 if $Y+9>IOSL
DO PAGE^SROQD0
if SRSOUT
QUIT
WRITE !,SRNAME,!
SET SRSNM=1
SET SRSD=0
FOR
SET SRSD=$ORDER(^TMP("SR",$JOB,DFN,SRSD))
if 'SRSD
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^TMP("SR",$JOB,DFN,SRSD,SRTN))
if 'SRTN!SRSOUT
QUIT
DO OP
+3 SET SRSNM=0
WRITE !
FOR I=1:1:IOM
WRITE "-"
+4 QUIT
OP ; print case information
+1 if SRSD<(SDATE-.0001)!(SRSD>(EDATE+.9999))
QUIT
if $Y+7>IOSL
DO PAGE^SROQD0
if SRSOUT
QUIT
+2 SET SRZ=^TMP("SR",$JOB,DFN,SRSD,SRTN)
SET Y=SRSD
SET SRSDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
SET Y=$PIECE(SRZ,"^")
SET SRSS=$SELECT(Y=9999:"SPECIALTY NOT ENTERED",1:$PIECE(^SRO(137.45,Y,0),"^"))
+3 SET Y=$PIECE(SRZ,"^",2)
SET SRIOSTAT=$SELECT(Y="I":"INPAT",Y="O":"OUTPAT",1:"???")
SET Y=$PIECE(SRZ,"^",3)
SET SRREL=$SELECT(Y="U":"UNRELATED",Y="R":"RELATED",1:"???")
+4 SET SRCON=$PIECE(SRZ,"^",4)
SET SRL=52
SET SRSUPCPT=1
DO PROC^SROUTL
+5 WRITE !,SRSDATE,?10,SRTN,?22,SRIOSTAT,?31,$EXTRACT(SRSS,1,35),?69,SRPROC(1),?123,SRREL,!
if SRCON
WRITE "*** CONCURRENT CASE #"_SRCON_" ***"
SET I=1
FOR
SET I=$ORDER(SRPROC(I))
if 'I
QUIT
WRITE ?69,SRPROC(I),!
+6 IF SRCON
IF '$DATA(SRPROC(2))
WRITE !
+7 QUIT
SPEC ; select national specialty
+1 WRITE @IOF,!
SET DIR("?",1)="Enter YES if you would like the report printed for all National Surgical"
SET DIR("?")="Specialties or enter NO to select a specific specialty."
+2 SET DIR("A")="Do you want the report for all National Surgical Specialties ? "
SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF 'Y
WRITE !
KILL DIC
SET DIC=45.3
SET DIC(0)="QEAMZ"
SET DIC("A")="Select National Surgical Specialty: "
SET DIC("S")="I '$P(^(0),""^"",3)"
DO ^DIC
KILL DIC
if Y<0
SET SRSOUT=1
if Y<0
QUIT
SET SRSPEC=+Y
SET SRSPECN=$PIECE(Y(0),"^")
+4 QUIT
