- SROQD0 ;BIR/ADM-Cases with Deaths within 30 Days ; [ 02/05/99 9:38 AM ]
- ;;3.0;Surgery;**62,70,50,87,182**;24 Jun 9;Build 49
- ;
- ;** NOTICE: This routine is part of an implementation of a nationally
- ;** controlled procedure. Local modifications to this routine
- ;** are prohibited.
- ;
- AC F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) S SRDTH=0 D CASE I SRDTH S ^TMP("SRDTH",$J,DFN)=""
- D MORT S DFN=0 F S DFN=$O(^TMP("SRDEATH",$J,DFN)) Q:'DFN D:SRSEL=1 TOT D:SRSEL=2 SPEC D:SRSEL=3 INDEX
- D CLEAN
- Q
- TOT S SRNM=^TMP("SRNM",$J,DFN) I $O(^TMP("SRREL",$J,DFN,0))="" S SRIOSTAT=^TMP("SRDEATH",$J,DFN),SRTN=^TMP("SRINOUT",$J,DFN,SRIOSTAT),^TMP("SRSEC",$J,SRIOSTAT,SRNM,DFN)=SRTN Q
- S SRSD=$O(^TMP("SRREL",$J,DFN,0)) I SRSD S SRTN=$O(^TMP("SRREL",$J,DFN,SRSD,0)) I SRTN S SRIOSTAT=^TMP("SRREL",$J,DFN,SRSD,SRTN),^TMP("SRSEC",$J,SRIOSTAT,SRNM,DFN)=SRTN
- Q
- SPEC S SRNM=^TMP("SRNM",$J,DFN) I $O(^TMP("SRREL",$J,DFN,0))="" S SRNAT=^TMP("SRDEATH",$J,DFN),SRTN=^TMP("SRNAT",$J,DFN,SRNAT),^TMP("SRSEC",$J,SRNAT,SRNM,DFN)=SRTN Q
- S SRSD=$O(^TMP("SRREL",$J,DFN,0)) I SRSD S SRTN=$O(^TMP("SRREL",$J,DFN,SRSD,0)) I SRTN S SRNAT=^TMP("SRREL",$J,DFN,SRSD,SRTN),^TMP("SRSEC",$J,SRNAT,SRNM,DFN)=SRTN
- Q
- INDEX S SRNM=^TMP("SRNM",$J,DFN) I $O(^TMP("SRREL",$J,DFN,0))="" S SRPROC=^TMP("SRDEATH",$J,DFN),SRTN=^TMP("SRNAT",$J,DFN,SRPROC),^TMP("SRSEC",$J,SRPROC,SRNM,DFN)=SRTN Q
- S SRSD=$O(^TMP("SRREL",$J,DFN,0)) I SRSD S SRTN=$O(^TMP("SRREL",$J,DFN,SRSD,0)) I SRTN S SRPROC=^TMP("SRREL",$J,DFN,SRSD,SRTN),^TMP("SRSEC",$J,SRPROC,SRNM,DFN)=SRTN
- Q
- CASE ; examine case
- Q:'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y")!$P($G(^SRF(SRTN,30)),"^")
- S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT Q:'$P(VADM(6),"^")
- S SRIOSTAT=$P(SR(0),"^",12) I SRIOSTAT'="I"&(SRIOSTAT'="O") S VAIP("D")=SRSD D IN5^VADPT S SRIOSTAT=$S(VAIP(13):"I",1:"O") K VAIP
- S Y=$P(SR(0),"^",4),SRSS=$S(Y:Y,1:9999)
- I SRSEL=2 S SRNAT=$S(SRSS=9999:9999,1:$P(^SRO(137.45,SRSS,0),"^",2))
- I SRSD<$P(VADM(6),"^") S X1=SRSD,X2=30 D C^%DTC I $P(VADM(6),"^")'>X S SRDTH=1
- I SRDTH S ^TMP("SRDTH",$J,DFN)=""
- Q
- TMP ; update ^TMP
- S SRREL=$P($G(^SRF(SRTN,.4)),"^",7) I '$D(^TMP("SR",$J,DFN)) S ^TMP("SRPAT",$J,VADM(1),DFN)=VA("PID")_"^"_$P(VADM(3),"^")_"^"_$P(VADM(6),"^"),^TMP("SRNM",$J,DFN)=VADM(1)
- S ^TMP("SR",$J,DFN,SRSD,SRTN)=SRSS_"^"_SRIOSTAT_"^"_SRREL_"^"_$P($G(^SRF(SRTN,"CON")),"^")
- I SRSEL=1 S ^TMP("SRDEATH",$J,DFN)=SRIOSTAT,^TMP("SRINOUT",$J,DFN,SRIOSTAT)=SRTN,^TMP("SRNAT",$J,DFN,SRSS)=SRTN I SRREL="R" S ^TMP("SRREL",$J,DFN,(9999999-SRSD),SRTN)=SRIOSTAT
- I SRSEL=2 S ^TMP("SRDEATH",$J,DFN)=SRNAT,^TMP("SRNAT",$J,DFN,SRNAT)=SRTN I SRREL="R" S ^TMP("SRREL",$J,DFN,(9999999-SRSD),SRTN)=SRNAT
- Q
- PAGE I $E(IOST)="P"!SRHDR G HDR
- D PRESS^SROQD I SRSOUT Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- W:$Y @IOF W:$E(IOST)="P" !,?(IOM-$L(SRINST)\2),SRINST W !,?(IOM-$L(SRRPT)\2),SRRPT,?(IOM-10),$J("PAGE "_SRPAGE,9),!,?(IOM-$L(SRFRTO)\2),SRFRTO
- W !,?(IOM-$L(SRPRINT)\2),SRPRINT I SRIO'="A" S X=$S(SRIO="I":"INPATIENT",SRIO=2:"INPATIENT",SRIO=3:"INPATIENT",1:"OUTPATIENT")_" DEATHS" W !,?(IOM-$L(X)\2),X
- Q:SRHDR2
- W !,?124,"DEATH",!,"OP DATE",?10,"CASE #",?22,"IN/OUT",?31,"SURGICAL SPECIALTY",?69,"PROCEDURE(S)",?123,"RELATED"
- S SRHDR=0,SRPAGE=SRPAGE+1 W ! F I=1:1:IOM W "="
- I SRSNM W !,SRNAME_" * * Continued from previous page * *",!
- Q
- SUM ; print category totals
- D:$Y+6>IOSL PAGE Q:SRSOUT
- W !,"TOTAL DEATHS: "_SRDTOT
- Q
- MORT ; look for operations in next quarter
- S X1=SDATE,X2=-30 D C^%DTC S SRSD1=9999999.999999-(X-.0001),X1=EDATE,X2=30 D C^%DTC S SRED1=9999999.999999-(X+.9999)
- S DFN=0 F S DFN=$O(^TMP("SRDTH",$J,DFN)) Q:'DFN D DEM^VADPT D
- .K ^TMP("SRTN",$J) S SRINV=SRED1 F S SRINV=$O(^SRF("ADT",DFN,SRINV)) Q:'SRINV!(SRINV>SRSD1) S SRTN=0 F S SRTN=$O(^SRF("ADT",DFN,SRINV,SRTN)) Q:'SRTN D
- ..S ^TMP("SRTN",$J,$P(^SRF(SRTN,0),"^",9),SRTN)=""
- .S SRSD=0 F S SRSD=$O(^TMP("SRTN",$J,SRSD)) Q:'SRSD S SRTN=0 F S SRTN=$O(^TMP("SRTN",$J,SRSD,SRTN)) Q:'SRTN S SRDTH=0 D CASE I SRDTH D TMP
- Q
- CLEAN ; deselect deaths attributable to operations outside date range
- S SRNAT="" F S SRNAT=$O(^TMP("SRSEC",$J,SRNAT)) Q:SRNAT="" S SRNM="" F S SRNM=$O(^TMP("SRSEC",$J,SRNAT,SRNM)) Q:SRNM="" S DFN=0 F S DFN=$O(^TMP("SRSEC",$J,SRNAT,SRNM,DFN)) Q:'DFN D
- .S SRTN=^TMP("SRSEC",$J,SRNAT,SRNM,DFN),SRSDATE=$P(^SRF(SRTN,0),"^",9) I SRSDATE>(EDATE+.9999)!(SRSDATE<(SDATE-.0001)) D
- ..K ^TMP("SRSEC",$J,SRNAT,SRNM,DFN),^TMP("SRDEATH",$J,DFN),^TMP("SRNM",$J,DFN),^TMP("SRPAT",$J,SRNM,DFN)
- ..K ^TMP("SRINOUT",$J,DFN),^TMP("SRNAT",$J,DFN),^TMP("SRREL",$J,DFN),^TMP("SR",$J,DFN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROQD0 4778 printed Jan 18, 2025@03:46:39 Page 2
- SROQD0 ;BIR/ADM-Cases with Deaths within 30 Days ; [ 02/05/99 9:38 AM ]
- +1 ;;3.0;Surgery;**62,70,50,87,182**;24 Jun 9;Build 49
- +2 ;
- +3 ;** NOTICE: This routine is part of an implementation of a nationally
- +4 ;** controlled procedure. Local modifications to this routine
- +5 ;** are prohibited.
- +6 ;
- AC FOR
- SET SRSD=$ORDER(^SRF("AC",SRSD))
- if 'SRSD!(SRSD>SRED)!SRSOUT
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRSD,SRTN))
- if 'SRTN
- QUIT
- IF $DATA(^SRF(SRTN,0))
- IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
- SET SRDTH=0
- DO CASE
- IF SRDTH
- SET ^TMP("SRDTH",$JOB,DFN)=""
- +1 DO MORT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP("SRDEATH",$JOB,DFN))
- if 'DFN
- QUIT
- if SRSEL=1
- DO TOT
- if SRSEL=2
- DO SPEC
- if SRSEL=3
- DO INDEX
- +2 DO CLEAN
- +3 QUIT
- TOT SET SRNM=^TMP("SRNM",$JOB,DFN)
- IF $ORDER(^TMP("SRREL",$JOB,DFN,0))=""
- SET SRIOSTAT=^TMP("SRDEATH",$JOB,DFN)
- SET SRTN=^TMP("SRINOUT",$JOB,DFN,SRIOSTAT)
- SET ^TMP("SRSEC",$JOB,SRIOSTAT,SRNM,DFN)=SRTN
- QUIT
- +1 SET SRSD=$ORDER(^TMP("SRREL",$JOB,DFN,0))
- IF SRSD
- SET SRTN=$ORDER(^TMP("SRREL",$JOB,DFN,SRSD,0))
- IF SRTN
- SET SRIOSTAT=^TMP("SRREL",$JOB,DFN,SRSD,SRTN)
- SET ^TMP("SRSEC",$JOB,SRIOSTAT,SRNM,DFN)=SRTN
- +2 QUIT
- SPEC SET SRNM=^TMP("SRNM",$JOB,DFN)
- IF $ORDER(^TMP("SRREL",$JOB,DFN,0))=""
- SET SRNAT=^TMP("SRDEATH",$JOB,DFN)
- SET SRTN=^TMP("SRNAT",$JOB,DFN,SRNAT)
- SET ^TMP("SRSEC",$JOB,SRNAT,SRNM,DFN)=SRTN
- QUIT
- +1 SET SRSD=$ORDER(^TMP("SRREL",$JOB,DFN,0))
- IF SRSD
- SET SRTN=$ORDER(^TMP("SRREL",$JOB,DFN,SRSD,0))
- IF SRTN
- SET SRNAT=^TMP("SRREL",$JOB,DFN,SRSD,SRTN)
- SET ^TMP("SRSEC",$JOB,SRNAT,SRNM,DFN)=SRTN
- +2 QUIT
- INDEX SET SRNM=^TMP("SRNM",$JOB,DFN)
- IF $ORDER(^TMP("SRREL",$JOB,DFN,0))=""
- SET SRPROC=^TMP("SRDEATH",$JOB,DFN)
- SET SRTN=^TMP("SRNAT",$JOB,DFN,SRPROC)
- SET ^TMP("SRSEC",$JOB,SRPROC,SRNM,DFN)=SRTN
- QUIT
- +1 SET SRSD=$ORDER(^TMP("SRREL",$JOB,DFN,0))
- IF SRSD
- SET SRTN=$ORDER(^TMP("SRREL",$JOB,DFN,SRSD,0))
- IF SRTN
- SET SRPROC=^TMP("SRREL",$JOB,DFN,SRSD,SRTN)
- SET ^TMP("SRSEC",$JOB,SRPROC,SRNM,DFN)=SRTN
- +2 QUIT
- CASE ; examine case
- +1 if '$PIECE($GET(^SRF(SRTN,.2)),"^",12)!($PIECE($GET(^SRF(SRTN,"NON")),"^")="Y")!$PIECE($GET(^SRF(SRTN,30)),"^")
- QUIT
- +2 SET SR(0)=^SRF(SRTN,0)
- SET DFN=$PIECE(SR(0),"^")
- DO DEM^VADPT
- if '$PIECE(VADM(6),"^")
- QUIT
- +3 SET SRIOSTAT=$PIECE(SR(0),"^",12)
- IF SRIOSTAT'="I"&(SRIOSTAT'="O")
- SET VAIP("D")=SRSD
- DO IN5^VADPT
- SET SRIOSTAT=$SELECT(VAIP(13):"I",1:"O")
- KILL VAIP
- +4 SET Y=$PIECE(SR(0),"^",4)
- SET SRSS=$SELECT(Y:Y,1:9999)
- +5 IF SRSEL=2
- SET SRNAT=$SELECT(SRSS=9999:9999,1:$PIECE(^SRO(137.45,SRSS,0),"^",2))
- +6 IF SRSD<$PIECE(VADM(6),"^")
- SET X1=SRSD
- SET X2=30
- DO C^%DTC
- IF $PIECE(VADM(6),"^")'>X
- SET SRDTH=1
- +7 IF SRDTH
- SET ^TMP("SRDTH",$JOB,DFN)=""
- +8 QUIT
- TMP ; update ^TMP
- +1 SET SRREL=$PIECE($GET(^SRF(SRTN,.4)),"^",7)
- IF '$DATA(^TMP("SR",$JOB,DFN))
- SET ^TMP("SRPAT",$JOB,VADM(1),DFN)=VA("PID")_"^"_$PIECE(VADM(3),"^")_"^"_$PIECE(VADM(6),"^")
- SET ^TMP("SRNM",$JOB,DFN)=VADM(1)
- +2 SET ^TMP("SR",$JOB,DFN,SRSD,SRTN)=SRSS_"^"_SRIOSTAT_"^"_SRREL_"^"_$PIECE($GET(^SRF(SRTN,"CON")),"^")
- +3 IF SRSEL=1
- SET ^TMP("SRDEATH",$JOB,DFN)=SRIOSTAT
- SET ^TMP("SRINOUT",$JOB,DFN,SRIOSTAT)=SRTN
- SET ^TMP("SRNAT",$JOB,DFN,SRSS)=SRTN
- IF SRREL="R"
- SET ^TMP("SRREL",$JOB,DFN,(9999999-SRSD),SRTN)=SRIOSTAT
- +4 IF SRSEL=2
- SET ^TMP("SRDEATH",$JOB,DFN)=SRNAT
- SET ^TMP("SRNAT",$JOB,DFN,SRNAT)=SRTN
- IF SRREL="R"
- SET ^TMP("SRREL",$JOB,DFN,(9999999-SRSD),SRTN)=SRNAT
- +5 QUIT
- PAGE IF $EXTRACT(IOST)="P"!SRHDR
- GOTO HDR
- +1 DO PRESS^SROQD
- IF SRSOUT
- QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 if $Y
- WRITE @IOF
- if $EXTRACT(IOST)="P"
- WRITE !,?(IOM-$LENGTH(SRINST)\2),SRINST
- WRITE !,?(IOM-$LENGTH(SRRPT)\2),SRRPT,?(IOM-10),$JUSTIFY("PAGE "_SRPAGE,9),!,?(IOM-$LENGTH(SRFRTO)\2),SRFRTO
- +3 WRITE !,?(IOM-$LENGTH(SRPRINT)\2),SRPRINT
- IF SRIO'="A"
- SET X=$SELECT(SRIO="I":"INPATIENT",SRIO=2:"INPATIENT",SRIO=3:"INPATIENT",1:"OUTPATIENT")_" DEATHS"
- WRITE !,?(IOM-$LENGTH(X)\2),X
- +4 if SRHDR2
- QUIT
- +5 WRITE !,?124,"DEATH",!,"OP DATE",?10,"CASE #",?22,"IN/OUT",?31,"SURGICAL SPECIALTY",?69,"PROCEDURE(S)",?123,"RELATED"
- +6 SET SRHDR=0
- SET SRPAGE=SRPAGE+1
- WRITE !
- FOR I=1:1:IOM
- WRITE "="
- +7 IF SRSNM
- WRITE !,SRNAME_" * * Continued from previous page * *",!
- +8 QUIT
- SUM ; print category totals
- +1 if $Y+6>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- +2 WRITE !,"TOTAL DEATHS: "_SRDTOT
- +3 QUIT
- MORT ; look for operations in next quarter
- +1 SET X1=SDATE
- SET X2=-30
- DO C^%DTC
- SET SRSD1=9999999.999999-(X-.0001)
- SET X1=EDATE
- SET X2=30
- DO C^%DTC
- SET SRED1=9999999.999999-(X+.9999)
- +2 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP("SRDTH",$JOB,DFN))
- if 'DFN
- QUIT
- DO DEM^VADPT
- Begin DoDot:1
- +3 KILL ^TMP("SRTN",$JOB)
- SET SRINV=SRED1
- FOR
- SET SRINV=$ORDER(^SRF("ADT",DFN,SRINV))
- if 'SRINV!(SRINV>SRSD1)
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("ADT",DFN,SRINV,SRTN))
- if 'SRTN
- QUIT
- Begin DoDot:2
- +4 SET ^TMP("SRTN",$JOB,$PIECE(^SRF(SRTN,0),"^",9),SRTN)=""
- End DoDot:2
- +5 SET SRSD=0
- FOR
- SET SRSD=$ORDER(^TMP("SRTN",$JOB,SRSD))
- if 'SRSD
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SRTN",$JOB,SRSD,SRTN))
- if 'SRTN
- QUIT
- SET SRDTH=0
- DO CASE
- IF SRDTH
- DO TMP
- End DoDot:1
- +6 QUIT
- CLEAN ; deselect deaths attributable to operations outside date range
- +1 SET SRNAT=""
- FOR
- SET SRNAT=$ORDER(^TMP("SRSEC",$JOB,SRNAT))
- if SRNAT=""
- QUIT
- SET SRNM=""
- FOR
- SET SRNM=$ORDER(^TMP("SRSEC",$JOB,SRNAT,SRNM))
- if SRNM=""
- QUIT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP("SRSEC",$JOB,SRNAT,SRNM,DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +2 SET SRTN=^TMP("SRSEC",$JOB,SRNAT,SRNM,DFN)
- SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
- IF SRSDATE>(EDATE+.9999)!(SRSDATE<(SDATE-.0001))
- Begin DoDot:2
- +3 KILL ^TMP("SRSEC",$JOB,SRNAT,SRNM,DFN),^TMP("SRDEATH",$JOB,DFN),^TMP("SRNM",$JOB,DFN),^TMP("SRPAT",$JOB,SRNM,DFN)
- +4 KILL ^TMP("SRINOUT",$JOB,DFN),^TMP("SRNAT",$JOB,DFN),^TMP("SRREL",$JOB,DFN),^TMP("SR",$JOB,DFN)
- End DoDot:2
- End DoDot:1
- +5 QUIT