- 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 Jan 18, 2025@03:46:38 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