- LRAPTT ;AVAMC/REG/CYM - TURNAROUND TIME PATH 2/13/98 09:36 ; 13-Aug-2013 09:10 ; MKK
- ;;5.2;LAB SERVICE;**1,72,1006,201,1018,397,1033**;NOV 01, 1997
- ;
- D ^LRAP Q:'$D(Y)
- J I LRSS="AU" W !?15,"1. Turnaround time for PAD",!?15,"2. Turnaround time for FAD",!,"Select 1 or 2: " R X:DTIME G:X=""!(X[U) END S LR("AU")=X I X'=1&(X'=2) D H G J
- D B^LRU G:Y<0 END S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99,LRL=0
- W !,"Identify cases exceeding turnaround time limit " S %=2 D YN^LRU I %=1 D T^LRAPTT1 G:X[U END
- S ZTRTN="QUE^LRAPTT" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO K ^TMP($J) S LRD="",(LRE,LRF,LRA,LRM)=0 D XR^LRU,L^LRU,S^LRU,^LRAPTT1 S LR("F")=1 F A=0:0 S A=$O(^DIC("AC","LR",A)) Q:'A S (LRE(A),LRF(A),LRM(A),LRA(A))=0
- F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D I
- F LRH=0:0 S LRH=$O(^TMP($J,LRH)) Q:'LRH!(LR("Q")) D N
- G:LR("Q") OUT S B=0 F A=0:0 S A=$O(LRM(A)) Q:'A I A'=2,LRM(A) S B=1 Q
- I B D:$Y>(IOSL-8) ^LRAPTT1 Q:LR("Q") W !!,"If '#', '*' or '?' is after Acc # then demographic data is in file indicated:",!?7,"# = Referral file * = Research file ? = Other file listed below"
- I LRSS="AU" W !?6,"F= FULL AUTOPSY H= HEAD ONLY T= TRUNK ONLY O=OTHER LIMITATION"
- D:$Y>(IOSL-8) ^LRAPTT1 Q:LR("Q") S X=LRM-LRF W !!,"Total cases:",$J(LRM,4) W:X !?3,"Incomplete cases:",$J(X,4) W !?3,"Complete cases:",$J(LRF,4)
- W:LRF !?5,"Average turnaround time (days): ",$J(LRE/LRF,2,2) W:LRL&(LRF) ?44,"Cases exceeding limit: ",LRA," (",$J(LRA/LRF*100,2,2),"%)" D F^LRAPTT1
- OUT K ^TMP($J) W:IOST'?1"C".E @IOF D END^LRUTL,V^LRU Q
- N S LRZ=0 F S LRZ=$O(^TMP($J,LRH,LRZ)) Q:LRZ=""!(LR("Q")) D:$Y>(IOSL-6) ^LRAPTT1 Q:LR("Q") S Y=^TMP($J,LRH,LRZ) D B
- Q
- B W !,$J(LRZ,5),?5,$P(Y,U,8),?6,$P(Y,U,9),?8,$P(Y,U),?19,$E($P(Y,U,2),1,20),?40,$P(Y,U,3),?46,$P(Y,U,5),?51,$P(Y,U,4),?62,$J($P(Y,U,6),3),?66,$E($P(Y,U,7),1,13) Q
- I F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN S M(2)="" D @($S("CYEMSP"[LRSS:"L",1:"A"))
- Q
- L Q:'$D(^LR(LRDFN,0))
- F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI I $D(^LR(LRDFN,LRSS,LRI,0)) S X=^(0) D G:$P($P(X,"^",6)," ")=LRABV
- S LREND=0 Q
- G S Y=$P(X,U,11),Z=+$P($P(X,U,6)," ",3),W=$P(X,U,15),LRC=$S(W>1:W,Y>1:Y,Y=1:$P(X,U,3),1:""),H(4)=$P(X,U,2),LRR=$P(X,U,10),H(9)=$P(X,U,9),X=^LR(LRDFN,0) S:Z="" Z="??" D S Q
- S D ^LRUP Q:$G(LREND) S LRX=P("F") S:'$D(LRF(LRX))#2 LRF(LRX)=0
- S:LRC LRF=LRF+1,LRF(LRX)=LRF(LRX)+1 S LRM=LRM+1,LRM(LRX)=LRM(LRX)+1,X1=LRC,X2=LRR D ^%DTC S:X=0 X="<1" S LRT=X I X>1 S LRY=X-1,Y=0,X=$P(LRR,".") D D
- S LRE=LRE+LRT,LRE(LRX)=LRE(LRX)+LRT I LRC,LRL,LRT<LRL Q
- I H(4),$D(^VA(200,H(4),0)) S X=$P(^(0),U),H(4)=$S(X[",":$E($P(X,","),1,16),1:$E(X,1,16))
- S H(5)=$$Y2K^LRX(LRR,"5D"),H("F")=$S(+LRC:$$Y2K^LRX(LRC,"5D"),1:""),X=$S(LRX=2:"",LRX=67:"#",LRX=67.1:"*",1:"?")
- S:'LRR LRR="?" S ^TMP($J,$E(LRR,1,3),Z)=H(5)_U_LRP_U_SSN(1)_U_H("F")_U_H(9)_U_LRT_U_H(4)_U_X_U_LRD S:LRC LRA=LRA+1,LRA(LRX)=LRA(LRX)+1 Q
- A S X=$G(^LR(LRDFN,"AU")) Q:$P($P(X,U,6)," ")'=LRABV S LRR=$P(X,U),Z=$P($P(X,U,6)," ",3),LRC=$S(LR("AU")=1:$P(X,U,17),1:$P(X,U,3)),LRD=$P(X,U,11),H(4)=$P(X,U,10),H(9)=$P(X,U,13),X=^LR(LRDFN,0)
- D S Q
- ;
- D F K=1:1:LRY S X1=X,X2=1 D C^%DTC,H^%DTC S K(X)=%Y
- F K=0:0 S K=$O(K(K)) Q:'K D C
- S LRT=LRT-Y K K Q
- C I "06"[K(K) S Y=Y+1 Q
- S:$D(^HOLIDAY(K)) Y=Y+1 Q
- ;
- H W !!,"Enter 1 for Provisional Anatomic Diagnoses (PAD)",!,"Enter 2 for Final Anatomic Diagnoses (FAD)" Q
- END D V^LRU Q
- LRAPTT ;AVAMC/REG/CYM - TURNAROUND TIME PATH 2/13/98 09:36 ; 13-Aug-2013 09:10 ; MKK
- +1 ;;5.2;LAB SERVICE;**1,72,1006,201,1018,397,1033**;NOV 01, 1997
- +2 ;
- +3 DO ^LRAP
- IF '$DATA(Y)
- QUIT
- J IF LRSS="AU"
- WRITE !?15,"1. Turnaround time for PAD",!?15,"2. Turnaround time for FAD",!,"Select 1 or 2: "
- READ X:DTIME
- IF X=""!(X[U)
- GOTO END
- SET LR("AU")=X
- IF X'=1&(X'=2)
- DO H
- GOTO J
- +1 DO B^LRU
- IF Y<0
- GOTO END
- SET LRSDT=LRSDT-.01
- SET LRLDT=LRLDT+.99
- SET LRL=0
- +2 WRITE !,"Identify cases exceeding turnaround time limit "
- SET %=2
- DO YN^LRU
- IF %=1
- DO T^LRAPTT1
- IF X[U
- GOTO END
- +3 SET ZTRTN="QUE^LRAPTT"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- KILL ^TMP($JOB)
- SET LRD=""
- SET (LRE,LRF,LRA,LRM)=0
- DO XR^LRU
- DO L^LRU
- DO S^LRU
- DO ^LRAPTT1
- SET LR("F")=1
- FOR A=0:0
- SET A=$ORDER(^DIC("AC","LR",A))
- IF 'A
- QUIT
- SET (LRE(A),LRF(A),LRM(A),LRA(A))=0
- +1 FOR X=0:0
- SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
- IF 'LRSDT!(LRSDT>LRLDT)
- QUIT
- DO I
- +2 FOR LRH=0:0
- SET LRH=$ORDER(^TMP($JOB,LRH))
- IF 'LRH!(LR("Q"))
- QUIT
- DO N
- +3 IF LR("Q")
- GOTO OUT
- SET B=0
- FOR A=0:0
- SET A=$ORDER(LRM(A))
- IF 'A
- QUIT
- IF A'=2
- IF LRM(A)
- SET B=1
- QUIT
- +4 IF B
- IF $Y>(IOSL-8)
- DO ^LRAPTT1
- IF LR("Q")
- QUIT
- WRITE !!,"If '#', '*' or '?' is after Acc # then demographic data is in file indicated:",!?7,"# = Referral file * = Research file ? = Other file listed below"
- +5 IF LRSS="AU"
- WRITE !?6,"F= FULL AUTOPSY H= HEAD ONLY T= TRUNK ONLY O=OTHER LIMITATION"
- +6 IF $Y>(IOSL-8)
- DO ^LRAPTT1
- IF LR("Q")
- QUIT
- SET X=LRM-LRF
- WRITE !!,"Total cases:",$JUSTIFY(LRM,4)
- IF X
- WRITE !?3,"Incomplete cases:",$JUSTIFY(X,4)
- WRITE !?3,"Complete cases:",$JUSTIFY(LRF,4)
- +7 IF LRF
- WRITE !?5,"Average turnaround time (days): ",$JUSTIFY(LRE/LRF,2,2)
- IF LRL&(LRF)
- WRITE ?44,"Cases exceeding limit: ",LRA," (",$JUSTIFY(LRA/LRF*100,2,2),"%)"
- DO F^LRAPTT1
- OUT KILL ^TMP($JOB)
- IF IOST'?1"C".E
- WRITE @IOF
- DO END^LRUTL
- DO V^LRU
- QUIT
- N SET LRZ=0
- FOR
- SET LRZ=$ORDER(^TMP($JOB,LRH,LRZ))
- IF LRZ=""!(LR("Q"))
- QUIT
- IF $Y>(IOSL-6)
- DO ^LRAPTT1
- IF LR("Q")
- QUIT
- SET Y=^TMP($JOB,LRH,LRZ)
- DO B
- +1 QUIT
- B WRITE !,$JUSTIFY(LRZ,5),?5,$PIECE(Y,U,8),?6,$PIECE(Y,U,9),?8,$PIECE(Y,U),?19,$EXTRACT($PIECE(Y,U,2),1,20),?40,$PIECE(Y,U,3),?46,$PIECE(Y,U,5),?51,$PIECE(Y,U,4),?62,$JUSTIFY($PIECE(Y,U,6),3),?66,$EXTRACT($PIECE(Y,U,7),1,13)
- QUIT
- I FOR LRDFN=0:0
- SET LRDFN=$ORDER(^LR(LRXR,LRSDT,LRDFN))
- IF 'LRDFN
- QUIT
- SET M(2)=""
- DO @($SELECT("CYEMSP"[LRSS:"L",1:"A"))
- +1 QUIT
- L IF '$DATA(^LR(LRDFN,0))
- QUIT
- +1 FOR LRI=0:0
- SET LRI=$ORDER(^LR(LRXR,LRSDT,LRDFN,LRI))
- IF 'LRI
- QUIT
- IF $DATA(^LR(LRDFN,LRSS,LRI,0))
- SET X=^(0)
- IF $PIECE($PIECE(X,"^",6)," ")=LRABV
- DO G
- +2 SET LREND=0
- QUIT
- G SET Y=$PIECE(X,U,11)
- SET Z=+$PIECE($PIECE(X,U,6)," ",3)
- SET W=$PIECE(X,U,15)
- SET LRC=$SELECT(W>1:W,Y>1:Y,Y=1:$PIECE(X,U,3),1:"")
- SET H(4)=$PIECE(X,U,2)
- SET LRR=$PIECE(X,U,10)
- SET H(9)=$PIECE(X,U,9)
- SET X=^LR(LRDFN,0)
- IF Z=""
- SET Z="??"
- DO S
- QUIT
- S DO ^LRUP
- IF $GET(LREND)
- QUIT
- SET LRX=P("F")
- IF '$DATA(LRF(LRX))#2
- SET LRF(LRX)=0
- +1 IF LRC
- SET LRF=LRF+1
- SET LRF(LRX)=LRF(LRX)+1
- SET LRM=LRM+1
- SET LRM(LRX)=LRM(LRX)+1
- SET X1=LRC
- SET X2=LRR
- DO ^%DTC
- IF X=0
- SET X="<1"
- SET LRT=X
- IF X>1
- SET LRY=X-1
- SET Y=0
- SET X=$PIECE(LRR,".")
- DO D
- +2 SET LRE=LRE+LRT
- SET LRE(LRX)=LRE(LRX)+LRT
- IF LRC
- IF LRL
- IF LRT<LRL
- QUIT
- +3 IF H(4)
- IF $DATA(^VA(200,H(4),0))
- SET X=$PIECE(^(0),U)
- SET H(4)=$SELECT(X[",":$EXTRACT($PIECE(X,","),1,16),1:$EXTRACT(X,1,16))
- +4 SET H(5)=$$Y2K^LRX(LRR,"5D")
- SET H("F")=$SELECT(+LRC:$$Y2K^LRX(LRC,"5D"),1:"")
- SET X=$SELECT(LRX=2:"",LRX=67:"#",LRX=67.1:"*",1:"?")
- +5 IF 'LRR
- SET LRR="?"
- SET ^TMP($JOB,$EXTRACT(LRR,1,3),Z)=H(5)_U_LRP_U_SSN(1)_U_H("F")_U_H(9)_U_LRT_U_H(4)_U_X_U_LRD
- IF LRC
- SET LRA=LRA+1
- SET LRA(LRX)=LRA(LRX)+1
- QUIT
- A SET X=$GET(^LR(LRDFN,"AU"))
- IF $PIECE($PIECE(X,U,6)," ")'=LRABV
- QUIT
- SET LRR=$PIECE(X,U)
- SET Z=$PIECE($PIECE(X,U,6)," ",3)
- SET LRC=$SELECT(LR("AU")=1:$PIECE(X,U,17),1:$PIECE(X,U,3))
- SET LRD=$PIECE(X,U,11)
- SET H(4)=$PIECE(X,U,10)
- SET H(9)=$PIECE(X,U,13)
- SET X=^LR(LRDFN,0)
- +1 DO S
- QUIT
- +2 ;
- D FOR K=1:1:LRY
- SET X1=X
- SET X2=1
- DO C^%DTC
- DO H^%DTC
- SET K(X)=%Y
- +1 FOR K=0:0
- SET K=$ORDER(K(K))
- IF 'K
- QUIT
- DO C
- +2 SET LRT=LRT-Y
- KILL K
- QUIT
- C IF "06"[K(K)
- SET Y=Y+1
- QUIT
- +1 IF $DATA(^HOLIDAY(K))
- SET Y=Y+1
- QUIT
- +2 ;
- H WRITE !!,"Enter 1 for Provisional Anatomic Diagnoses (PAD)",!,"Enter 2 for Final Anatomic Diagnoses (FAD)"
- QUIT
- END DO V^LRU
- QUIT
