- LRAURV ; IHS/DIR/AAB - AUTOPSY DATA REVIEW 2/18/93 12:24 ; [ 07/22/2002 1:12 PM ]
- ;;5.2;LR;**1006,1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;**155**;Sep 27, 1994
- S LRDICS="AU" D ^LRAP G:'$D(Y) END
- W !!?20,"Autopsy data review"
- D B^LRU G:Y<0 END S LRLDT=LRLDT+.99,LRSDT=LRSDT-.0001
- S LRB=0 W !!,"Count only in-patient deaths " S %=1 D YN^LRU G:%<1 END I %=1 S LRB=1
- S ZTRTN="QUE^LRAURV" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE K ^TMP($J) U IO S (LR("Q"),LRA,LRD,G(0),G(1),C(0),C(1),C(2))="" D XR^LRU,L^LRU,S^LRU,H S LR("F")=1
- S A=0 F B=0:0 S A=$O(^DG(405.2,"B",A)) Q:A="" I A["DEATH"!(A="WHILE ASIH") S X=$O(^(A,0)) I X S:A["DEATH" LRC(X)="" S:A["ASIH" LRJ(X)="" ;MAS
- F A=LRSDT:0 S A=$O(^LR(LRXR,A)) Q:'A!(A>LRLDT)!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,A,LRDFN)) Q:'LRDFN!(LR("Q")) S LRX=$G(^LR(LRDFN,"AU")),LRAC=$P(LRX,U,6) I $P(LRAC," ")=LRABV D A Q:LR("Q") I $D(^LR(LRDFN,83)) S X=^(83) D W
- Q:LR("Q") I IOST?1"C".E W !!,"Please hold, calculating Autopsy% ...",!
- F A=LRSDT:0 S A=$O(^DPT("AEXP1",A)) Q:'A!(A>LRLDT) F DFN=0:0 S DFN=$O(^DPT("AEXP1",A,DFN)) Q:'DFN S:'LRB LRD=LRD+1 D:LRB P I $D(LRK) S LRD=LRD+1 K LRK
- S LRF=1 D H Q:LR("Q") W !,$J(LRD,7),?10,$J(LRA,8),?25,$J(LRA/$S('LRD:1,1:LRD)*100,5,1),?34,$J(G(1),6),?45,$J(G(0),6),?55,$J(C(1),5),?63,$J(C(0),4),?70,$J(C(2),4)
- D END^LRUTL,END Q
- W I LRB,'LRG Q
- S Y=$P(X,"^",2),X=$P(X,"^") S:X]"" G(X)=G(X)+1 S:Y]"" C(Y)=C(Y)+1 W:X ?36,"X" W:X=0 ?46,"X" W:Y=1 ?57,"X" W:Y=0 ?64,"X" W:Y=2 ?74,"X" Q
- A D:$Y>(IOSL-6) H Q:LR("Q") S LRG=0,Y=+LRX D D^LRU S LRY=Y I 'LRB D B S LRA=LRA+1 Q
- S X=^LR(LRDFN,0),DFN=$P(X,"^",3) Q:$P(X,"^",2)'=2 D P I $D(LRK) D B S LRA=LRA+1,LRG=1 K LRK
- Q
- P S Y=0,X=$O(^DGPM("ATID3",DFN,0)) Q:'X S Y=$O(^(X,0)) Q:'Y S Z=$S($D(^DGPM(Y,0)):$P(^(0),"^",18),1:0) Q:'Z I $D(LRC(Z)) S LRK=1 Q
- Q:'$D(LRJ(Z)) S X=$O(^DGPM("ATID3",DFN,X)) Q:'X S Y=$O(^DGPM("ATID3",DFN,X,Y)) Q:'Y S Z=+$S($D(^DGPM(Y,0)):$P(^(0),"^",18),1:0) S:$D(LRC(Z)) LRK=1 Q
- ;
- B W !,LRAC,?15,LRY Q
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,LRO(68)," (",LRABV,") DATA REVIEW (",LRSTR,"-",LRLST,")"
- W !?34,"|DIAGNOSTIC",?54,"| CLINICAL DIAGNOSIS",! W "|----------",$S(LRB:"In-patient",1:"--Total---"),"-------------" W ?34,"|DISAGREEMENT",?54,"| CLARIFIED"
- I $D(LRF) W !,"# Deaths",?10,"# Autopsies",?25,"Autopsy%",?34,"|#Yes",?45,"#No",?54,"| #Yes",?63,"#No"
- E W !,"Autopsy",?10,"Autopsy date",?34,"| Yes",?46,"No",?54,"| Yes",?64,"No"
- W ?70,"Verified",!,LR("%") Q
- ;
- END D V^LRU Q
- LRAURV ; IHS/DIR/AAB - AUTOPSY DATA REVIEW 2/18/93 12:24 ; [ 07/22/2002 1:12 PM ]
- +1 ;;5.2;LR;**1006,1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;**155**;Sep 27, 1994
- +4 SET LRDICS="AU"
- DO ^LRAP
- IF '$DATA(Y)
- GOTO END
- +5 WRITE !!?20,"Autopsy data review"
- +6 DO B^LRU
- IF Y<0
- GOTO END
- SET LRLDT=LRLDT+.99
- SET LRSDT=LRSDT-.0001
- +7 SET LRB=0
- WRITE !!,"Count only in-patient deaths "
- SET %=1
- DO YN^LRU
- IF %<1
- GOTO END
- IF %=1
- SET LRB=1
- +8 SET ZTRTN="QUE^LRAURV"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE KILL ^TMP($JOB)
- USE IO
- SET (LR("Q"),LRA,LRD,G(0),G(1),C(0),C(1),C(2))=""
- DO XR^LRU
- DO L^LRU
- DO S^LRU
- DO H
- SET LR("F")=1
- +1 ;MAS
- SET A=0
- FOR B=0:0
- SET A=$ORDER(^DG(405.2,"B",A))
- IF A=""
- QUIT
- IF A["DEATH"!(A="WHILE ASIH")
- SET X=$ORDER(^(A,0))
- IF X
- IF A["DEATH"
- SET LRC(X)=""
- IF A["ASIH"
- SET LRJ(X)=""
- +2 FOR A=LRSDT:0
- SET A=$ORDER(^LR(LRXR,A))
- IF 'A!(A>LRLDT)!(LR("Q"))
- QUIT
- FOR LRDFN=0:0
- SET LRDFN=$ORDER(^LR(LRXR,A,LRDFN))
- IF 'LRDFN!(LR("Q"))
- QUIT
- SET LRX=$GET(^LR(LRDFN,"AU"))
- SET LRAC=$PIECE(LRX,U,6)
- IF $PIECE(LRAC," ")=LRABV
- DO A
- IF LR("Q")
- QUIT
- IF $DATA(^LR(LRDFN,83))
- SET X=^(83)
- DO W
- +3 IF LR("Q")
- QUIT
- IF IOST?1"C".E
- WRITE !!,"Please hold, calculating Autopsy% ...",!
- +4 FOR A=LRSDT:0
- SET A=$ORDER(^DPT("AEXP1",A))
- IF 'A!(A>LRLDT)
- QUIT
- FOR DFN=0:0
- SET DFN=$ORDER(^DPT("AEXP1",A,DFN))
- IF 'DFN
- QUIT
- IF 'LRB
- SET LRD=LRD+1
- IF LRB
- DO P
- IF $DATA(LRK)
- SET LRD=LRD+1
- KILL LRK
- +5 SET LRF=1
- DO H
- IF LR("Q")
- QUIT
- WRITE !,$JUSTIFY(LRD,7),?10,$JUSTIFY(LRA,8),?25,$JUSTIFY(LRA/$SELECT('LRD:1,1:LRD)*100,5,1),?34,$JUSTIFY(G(1),6),?45,$JUSTIFY(G(0),6),?55,$JUSTIFY(C(1),5),?63,$JUSTIFY(C(0),4),?70,$JUSTIFY(C(2),4)
- +6 DO END^LRUTL
- DO END
- QUIT
- W IF LRB
- IF 'LRG
- QUIT
- +1 SET Y=$PIECE(X,"^",2)
- SET X=$PIECE(X,"^")
- IF X]""
- SET G(X)=G(X)+1
- IF Y]""
- SET C(Y)=C(Y)+1
- IF X
- WRITE ?36,"X"
- IF X=0
- WRITE ?46,"X"
- IF Y=1
- WRITE ?57,"X"
- IF Y=0
- WRITE ?64,"X"
- IF Y=2
- WRITE ?74,"X"
- QUIT
- A IF $Y>(IOSL-6)
- DO H
- IF LR("Q")
- QUIT
- SET LRG=0
- SET Y=+LRX
- DO D^LRU
- SET LRY=Y
- IF 'LRB
- DO B
- SET LRA=LRA+1
- QUIT
- +1 SET X=^LR(LRDFN,0)
- SET DFN=$PIECE(X,"^",3)
- IF $PIECE(X,"^",2)'=2
- QUIT
- DO P
- IF $DATA(LRK)
- DO B
- SET LRA=LRA+1
- SET LRG=1
- KILL LRK
- +2 QUIT
- P SET Y=0
- SET X=$ORDER(^DGPM("ATID3",DFN,0))
- IF 'X
- QUIT
- SET Y=$ORDER(^(X,0))
- IF 'Y
- QUIT
- SET Z=$SELECT($DATA(^DGPM(Y,0)):$PIECE(^(0),"^",18),1:0)
- IF 'Z
- QUIT
- IF $DATA(LRC(Z))
- SET LRK=1
- QUIT
- +1 IF '$DATA(LRJ(Z))
- QUIT
- SET X=$ORDER(^DGPM("ATID3",DFN,X))
- IF 'X
- QUIT
- SET Y=$ORDER(^DGPM("ATID3",DFN,X,Y))
- IF 'Y
- QUIT
- SET Z=+$SELECT($DATA(^DGPM(Y,0)):$PIECE(^(0),"^",18),1:0)
- IF $DATA(LRC(Z))
- SET LRK=1
- QUIT
- +2 ;
- B WRITE !,LRAC,?15,LRY
- QUIT
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,LRO(68)," (",LRABV,") DATA REVIEW (",LRSTR,"-",LRLST,")"
- +2 WRITE !?34,"|DIAGNOSTIC",?54,"| CLINICAL DIAGNOSIS",!
- WRITE "|----------",$SELECT(LRB:"In-patient",1:"--Total---"),"-------------"
- WRITE ?34,"|DISAGREEMENT",?54,"| CLARIFIED"
- +3 IF $DATA(LRF)
- WRITE !,"# Deaths",?10,"# Autopsies",?25,"Autopsy%",?34,"|#Yes",?45,"#No",?54,"| #Yes",?63,"#No"
- +4 IF '$TEST
- WRITE !,"Autopsy",?10,"Autopsy date",?34,"| Yes",?46,"No",?54,"| Yes",?64,"No"
- +5 WRITE ?70,"Verified",!,LR("%")
- QUIT
- +6 ;
- END DO V^LRU
- QUIT
