Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROQD0

SROQD0.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;** NOTICE: This routine is part of an implementation of a nationally
  1. ;** controlled procedure. Local modifications to this routine
  1. ;** are prohibited.
  1. ;
  1. 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)=""
  1. 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
  1. D CLEAN
  1. Q
  1. 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
  1. 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
  1. Q
  1. 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
  1. 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
  1. Q
  1. 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
  1. 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
  1. Q
  1. CASE ; examine case
  1. Q:'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y")!$P($G(^SRF(SRTN,30)),"^")
  1. S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT Q:'$P(VADM(6),"^")
  1. 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
  1. S Y=$P(SR(0),"^",4),SRSS=$S(Y:Y,1:9999)
  1. I SRSEL=2 S SRNAT=$S(SRSS=9999:9999,1:$P(^SRO(137.45,SRSS,0),"^",2))
  1. I SRSD<$P(VADM(6),"^") S X1=SRSD,X2=30 D C^%DTC I $P(VADM(6),"^")'>X S SRDTH=1
  1. I SRDTH S ^TMP("SRDTH",$J,DFN)=""
  1. Q
  1. TMP ; update ^TMP
  1. 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)
  1. S ^TMP("SR",$J,DFN,SRSD,SRTN)=SRSS_"^"_SRIOSTAT_"^"_SRREL_"^"_$P($G(^SRF(SRTN,"CON")),"^")
  1. 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
  1. 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
  1. Q
  1. PAGE I $E(IOST)="P"!SRHDR G HDR
  1. D PRESS^SROQD I SRSOUT Q
  1. HDR ; print heading
  1. I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
  1. 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
  1. 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
  1. Q:SRHDR2
  1. W !,?124,"DEATH",!,"OP DATE",?10,"CASE #",?22,"IN/OUT",?31,"SURGICAL SPECIALTY",?69,"PROCEDURE(S)",?123,"RELATED"
  1. S SRHDR=0,SRPAGE=SRPAGE+1 W ! F I=1:1:IOM W "="
  1. I SRSNM W !,SRNAME_" * * Continued from previous page * *",!
  1. Q
  1. SUM ; print category totals
  1. D:$Y+6>IOSL PAGE Q:SRSOUT
  1. W !,"TOTAL DEATHS: "_SRDTOT
  1. Q
  1. MORT ; look for operations in next quarter
  1. 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)
  1. S DFN=0 F S DFN=$O(^TMP("SRDTH",$J,DFN)) Q:'DFN D DEM^VADPT D
  1. .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
  1. ..S ^TMP("SRTN",$J,$P(^SRF(SRTN,0),"^",9),SRTN)=""
  1. .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
  1. Q
  1. CLEAN ; deselect deaths attributable to operations outside date range
  1. 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
  1. .S SRTN=^TMP("SRSEC",$J,SRNAT,SRNM,DFN),SRSDATE=$P(^SRF(SRTN,0),"^",9) I SRSDATE>(EDATE+.9999)!(SRSDATE<(SDATE-.0001)) D
  1. ..K ^TMP("SRSEC",$J,SRNAT,SRNM,DFN),^TMP("SRDEATH",$J,DFN),^TMP("SRNM",$J,DFN),^TMP("SRPAT",$J,SRNM,DFN)
  1. ..K ^TMP("SRINOUT",$J,DFN),^TMP("SRNAT",$J,DFN),^TMP("SRREL",$J,DFN),^TMP("SR",$J,DFN)
  1. Q