LRHY4X ;VA/DALOI/HOAK - PHLEBOTOMY TAT ;4/13/1999
;;5.2;LAB SERVICE;**405,417,430**;NOV 01, 1997;Build 32
;
;
START ;
;
G ;
K ^TMP("LRHYMEDTAT",$J)
;
K ^TMP("LRHYCOLLECTOR",$J)
;
K ^TMP("LRHYTATDALLAS",$J)
K LRHYTECH1
K %DT
S %DT="AET"
S %DT("A")="Please enter date and time to start search: "
D ^%DT
Q:Y=-1
S LRSDT=Y
S LRODT=$P(LRSDT,".")
S %DT("A")="Please enter date and time to end search: "
D ^%DT
Q:Y=-1
S LREDT=Y
;
D DEVICE
K ^TMP("LRHYMEDTAT",$J),^TMP("LRHYMEDFINAL",$J)
K ^TMP("LRHYCOLLECTOR",$J),^TMP("LRHYTATDALLAS",$J)
QUIT
PAT ;
;
;
S LREND=0
S DIC="^DPT("
S DIC(0)="AEMQZ"
D ^DIC
S DFN=+Y
S LRDFN=$G(^DPT(DFN,"LR"))
D ^VADPT,INP^VADPT
;
QUIT
;
LRO69 ;
Q ;
U IO
S LREND=0
S LRSTAR=0
D HEAD
S LRSN=0
S LRSTOP=0
S LRDRAW1=LRODT
F S LRDRAW1=$O(^LRHY(69.87,"COLT",LRDRAW1)) Q:+LRDRAW1'>0!(LRDRAW1>LREDT)!(LRSTOP) D
. S LRUID=""
. F S LRUID=$O(^LRHY(69.87,"COLT",LRDRAW1,LRUID)) Q:LRUID="" D
.. ;
.. S LRUID=$G(^LRHY(69.87,LRUID,0))
.. I '$O(^LRO(68,"C",LRUID,0)) QUIT
.. S LRAA=$O(^LRO(68,"C",LRUID,0))
.. S LRAD=$O(^LRO(68,"C",LRUID,LRAA,0))
.. S LRAN=$O(^LRO(68,"C",LRUID,LRAA,LRAD,0))
.. D IN
D DISP
QUIT
IN ;
S LR6987=$O(^LRHY(69.87,"B",LRUID,0)) Q:'$G(LR6987)
D
. S LREND=0
. K LRARIVE
. S LRSN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5),LRORDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)
. S LRACCTM=$G(^LRHY(69.87,LR6987,2))
. S LRTKX=$G(^LRHY(69.87,LR6987,6))
. S LRARIVE=$G(^LRHY(69.87,LR6987,8))
. K LRNCOL
. S LR3D=$P(LRDRAW1,".",2)
. I $L(LR3D)'>3 S LR3D=LR3D_"0"
. S LR3D=$E(LR3D,1,2)*60+$E(LR3D,3,4)
. S LR3T=$P(LRACCTM,".",2)
. I $L(LR3T)'>3 S LR3T=LR3T_"0"
. S LR3T=$E(LR3T,1,2)*60+$E(LR3T,3,4)
. S LRTAT=(LR3D-LR3T)
. S LRDRAW=$E($P(LRDRAW1,".",2),1,2)_":"_$E($P(LRDRAW1,".",2),3,4)
. S LRARIVE=$E($P(LRACCTM,".",2),1,2)_":"_$E($P(LRACCTM,".",2),3,4)
. ;
. K LRDFN
. S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
. K LRDPF D PT^LRX
. S LRSSN=$P(SSN,"-",3)
. S LRAC1=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
. I LRAC1="" S LRAC1=$E($P(^LRO(68,LRAA,0),U),1,2)_" "_$E(LRAD,4,7)_" "_LRAN
. S LRAANAME=$P(^LRO(68,LRAA,0),U)
. ; check specimen not urine
. S LRLLOC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)
. S LRSC0=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,13)
. I $P($G(LRNCOL),U,4) S ^TMP("LRHYCOLLECTOR",$J,LRORDT_U_LRSN_U_LRUID,$P(LRNCOL,U,4))=""
. K LRHYTECH
. S LRHYTECH=$G(^LRHY(69.87,LR6987,12))
. ;
. ;
. S LRHYTECH=$G(LRTKX)
. I LRHYTECH S ^TMP("LRHYCOLLECTOR",$J,LRORDT_U_LRSN_U_LRUID,LRHYTECH)=""
. ;
. S LRSTAR=0
. ;
. S ^TMP("LRHYTATDALLAS",$J,$E(LRDRAW,1,2),LRORDT_U_LRSN_U_LRUID)=LRDRAW_U_PNM_U_LRSSN_U_LRARIVE_U_LRTAT_U_LRAC1_U_$G(LRSTAR)_U_$G(LRLLOC)
;
QUIT
;
DISP ;
;
;
S LRTOTAL=0
S LRHYCT=0
U IO
S LRD=0
S LR7MORE=0
S LR7LESS=0
S LR700=0
N LRE,LRTECH,LREXLINE
;
F S LRD=$O(^TMP("LRHYTATDALLAS",$J,LRD)) Q:+LRD'>0 D
. S LRE=""
. F S LRE=$O(^TMP("LRHYTATDALLAS",$J,LRD,LRE)) Q:+LRE'>0 S LRN=^(LRE) D
.. S LRSN=$P(LRE,U,2)
.. S LRDRAW=+LRN
.. S LRDRAW=$P(LRN,U)
.. S PNM=$P(LRN,U,2)
.. S LRSSN=$P(LRN,U,3)
.. S LRARIVE=$P(LRN,U,4)
.. S LRTAT=$P(LRN,U,5)
.. I LRTAT>7 S LR7MORE=LR7MORE+1
.. I LRTAT<7 S LR7LESS=LR7LESS+1
.. I LRTAT=7 S LR700=LR700+1
.. S LRAC1=$P(LRN,U,6)
.. S LRTECH=$O(^TMP("LRHYCOLLECTOR",$J,LRE,0))
.. S LREXLINE=$S($L(LRTECH)>6:1,1:0)
.. D CHK Q:LRSTOP
.. K LREXLINE
.. W !,+$E(LRD,1,2),?4,$E(PNM,1,14)," ",LRSSN,?25,"BLD",?30,LRARIVE,?37,LRDRAW,?44,LRTAT
.. W ?49,LRTECH
.. ;I $P(LRN,U,7)=1 W "*"
.. I $L(LRTECH)>6 W !
.. W ?56,LRAC1 ;accession
.. W ?73,$E($P(LRN,U,8),1,7) ;clinic
.. S LRHYCT=LRHYCT+1 S LRTOTAL=LRTOTAL+LRTAT
.. S ^TMP("LRHYMEDTAT",$J,LRE)=LRTAT
Q:'LRHYCT
W !!,?10,"Mean TAT: "
W ?35,$P(LRTOTAL/LRHYCT,".")_"."_$E($P(LRTOTAL/LRHYCT,".",2),1,1),?41
D MEDIAN W ?41," Minutes"
W !,?10,"Total Time: ",?35,LRTOTAL,?41," Minutes"
W !,?10,"Total Patients Drawn: ",?35,LRHYCT,!
W !,?15,"TAT > 7 minutes: ",LR7MORE
W !,?15,"TAT < 7 minutes: ",LR7LESS
W !,?15,"TAT = 7 minutes: ",LR700
I LRHYCT=0 S LRHYCT=1
;
;
W !,?5,"Collectors: "
S LRN5=0
F S LRN5=$O(^TMP("LRHYCOLLECTOR",$J,LRN5)) Q:+LRN5'>0 D
. S LRHYTECH=0
. F S LRHYTECH=$O(^TMP("LRHYCOLLECTOR",$J,LRN5,LRHYTECH)) Q:+LRHYTECH'>0 D
.. S LRHYTECH1(LRHYTECH,LRN5)=""
S LRHYTECH=0
F S LRHYTECH=$O(LRHYTECH1(LRHYTECH)) Q:+LRHYTECH'>0 D
. S LRHYCTC=0 S LRT0=0
. F S LRT0=$O(LRHYTECH1(LRHYTECH,LRT0)) Q:+LRT0'>0 D
.. S LRHYCTC=LRHYCTC+1
. I $D(^VA(200,LRHYTECH)) W !,?10,$P(^VA(200,LRHYTECH,0),U)
. W ?40,LRHYCTC,?45," Drawn"
K DIR I IOST["C-" S DIR(0)="E" D ^DIR
D ^%ZISC
QUIT
MEDIAN ;
N LR334 S LR334=0
F S LR334=$O(^TMP("LRHYMEDTAT",$J,LR334)) Q:+LR334'>0 I +$G(^TMP("LRHYMEDTAT",$J,LR334))'>0 S ^TMP("LRHYMEDTAT",$J,LR334)=1
S LRSTUCK=0
K ^TMP("LRHYMEDFINAL",$J)
K LRTATN
S LRHYCT3=1
BAK S LRX=0 S LRKIL=0 S LRNONONO=0 S LRM3=0
I $D(^TMP("LRHYMEDFINAL",$J)) D
. I '$D(^TMP("LRHYMEDFINAL",$J,LRHYCT3)) S LRSTUCK=LRSTUCK+1
STUCK I $G(LRSTUCK)>2 K ^TMP("LRHYMEDTAT",$J,LRDUP) S LRSTUCK=0
I '$D(^TMP("LRHYMEDTAT",$J)) G DONE QUIT
S LRHYCT3=LRHYCT3+1
S LRM1=$O(^TMP("LRHYMEDTAT",$J,LRX)) S (LRX,LRDUP)=LRM1
S LRM1=$G(^TMP("LRHYMEDTAT",$J,LRM1))
TIC F S LRX=$O(^TMP("LRHYMEDTAT",$J,LRX)) Q:+LRX'>0 S LRM2=^(LRX) D
. S LRKIL=LRX
. I LRM2=LRM1 S LRKIL=LRX S LRNOT=0 D
.. F LRY=1:1:LRHYCT3 Q:'$D(^TMP("LRHYMEDFINAL",$J,LRY)) D
... I LRM1>+$O(^TMP("LRHYMEDFINAL",$J,LRY,0)) S LRNOT=1
K ^TMP("LRHYMEDTAT",$J,LRDUP) S LRKIL=LRX
I $G(LRNOT)=1 S LRX=LRX+.05 S LRNOT=0 G TIC
I LRKIL K ^TMP("LRHYMEDTAT",$J,LRKIL)
I +$O(^TMP("LRHYMEDTAT",$J,0)) G BAK
S LRHYCT3=0
S LRX=0
F S LRX=$O(^TMP("LRHYMEDFINAL",$J,LRX)) Q:+LRX'>0 D
. S LRHYCT3=LRHYCT3+1
. S LRYTAT=$O(^TMP("LRHYMEDFINAL",$J,LRX,0))
. S LRTATN(LRHYCT3)=LRYTAT
S LRX=LRHYCT3/2
Q:'LRX
I LRX[.5 S LRX1=$P(LRX,".") Q:'LRX1 S LRX2=LRX1+1 D
. S LRX3=(LRTATN(LRX1)+LRTATN(LRX2))/2
E S LRX3=LRTATN(LRX)
W !,?10,"Median TAT:",?35,LRX3
;
QUIT
HEAD ;
S LRSTOP=0
W @IOF
W "Date:",$$Y2K^LRX(DT)," ",$$CJ^XLFSTR("PATIENT WAIT TIME",IOM)
W !,"Time",?5,"Patient Name",?25,"Type",?30,"Arrive"
W ?37,"Drawn",?44,"TAT",?49,"TECH",?57,"ACCN"
W ?73,"Clinic"
QUIT
CHK ;
Q:LRSTOP
S LRLINE=(IOSL-$Y)
I $E(IOST,1,2)["P-" D QUIT
. I LRLINE<(7+$G(LREXLINE)) D HEAD QUIT
;
I LRLINE<(2+$G(LREXLINE)) D
. Q:$E(IOST,1,2)'["C-"
. K DIR S DIR(0)="E" D ^DIR
. I $D(DUOUT)!($D(DIRUT)) S LRSTOP=1 Q
. D HEAD
QUIT
DONE ;
S LRHYCT3=0
S LRX=0
F S LRX=$O(^TMP("LRHYMEDFINAL",$J,LRX)) Q:+LRX'>0 D
. S LRHYCT3=LRHYCT3+1
. S LRYTAT=$O(^TMP("LRHYMEDFINAL",$J,LRX,0))
. S LRTATN(LRHYCT3)=LRYTAT
S LRX=LRHYCT3/2
I LRX[.5 S LRX1=$P(LRX,".") Q:'LRX1 S LRX2=LRX1+1 D
. S LRX3=(LRTATN(LRX1)+LRTATN(LRX2))/2
E S LRX3=LRTATN(LRX)
W !,?10,"Median TAT:",?35,LRX3
QUIT
DEVICE ;
S ZTRTN="Q^LRHY4X"
;
D IO^LRWU
;
QUIT
QUIT
LRHY4X ;VA/DALOI/HOAK - PHLEBOTOMY TAT ;4/13/1999
+1 ;;5.2;LAB SERVICE;**405,417,430**;NOV 01, 1997;Build 32
+2 ;
+3 ;
START ;
+1 ;
G ;
+1 KILL ^TMP("LRHYMEDTAT",$JOB)
+2 ;
+3 KILL ^TMP("LRHYCOLLECTOR",$JOB)
+4 ;
+5 KILL ^TMP("LRHYTATDALLAS",$JOB)
+6 KILL LRHYTECH1
+7 KILL %DT
+8 SET %DT="AET"
+9 SET %DT("A")="Please enter date and time to start search: "
+10 DO ^%DT
+11 IF Y=-1
QUIT
+12 SET LRSDT=Y
+13 SET LRODT=$PIECE(LRSDT,".")
+14 SET %DT("A")="Please enter date and time to end search: "
+15 DO ^%DT
+16 IF Y=-1
QUIT
+17 SET LREDT=Y
+18 ;
+19 DO DEVICE
+20 KILL ^TMP("LRHYMEDTAT",$JOB),^TMP("LRHYMEDFINAL",$JOB)
+21 KILL ^TMP("LRHYCOLLECTOR",$JOB),^TMP("LRHYTATDALLAS",$JOB)
+22 QUIT
PAT ;
+1 ;
+2 ;
+3 SET LREND=0
+4 SET DIC="^DPT("
+5 SET DIC(0)="AEMQZ"
+6 DO ^DIC
+7 SET DFN=+Y
+8 SET LRDFN=$GET(^DPT(DFN,"LR"))
+9 DO ^VADPT
DO INP^VADPT
+10 ;
+11 QUIT
+12 ;
LRO69 ;
Q ;
+1 USE IO
+2 SET LREND=0
+3 SET LRSTAR=0
+4 DO HEAD
+5 SET LRSN=0
+6 SET LRSTOP=0
+7 SET LRDRAW1=LRODT
+8 FOR
SET LRDRAW1=$ORDER(^LRHY(69.87,"COLT",LRDRAW1))
IF +LRDRAW1'>0!(LRDRAW1>LREDT)!(LRSTOP)
QUIT
Begin DoDot:1
+9 SET LRUID=""
+10 FOR
SET LRUID=$ORDER(^LRHY(69.87,"COLT",LRDRAW1,LRUID))
IF LRUID=""
QUIT
Begin DoDot:2
+11 ;
+12 SET LRUID=$GET(^LRHY(69.87,LRUID,0))
+13 IF '$ORDER(^LRO(68,"C",LRUID,0))
QUIT
+14 SET LRAA=$ORDER(^LRO(68,"C",LRUID,0))
+15 SET LRAD=$ORDER(^LRO(68,"C",LRUID,LRAA,0))
+16 SET LRAN=$ORDER(^LRO(68,"C",LRUID,LRAA,LRAD,0))
+17 DO IN
End DoDot:2
End DoDot:1
+18 DO DISP
+19 QUIT
IN ;
+1 SET LR6987=$ORDER(^LRHY(69.87,"B",LRUID,0))
IF '$GET(LR6987)
QUIT
+2 Begin DoDot:1
+3 SET LREND=0
+4 KILL LRARIVE
+5 SET LRSN=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5)
SET LRORDT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)
+6 SET LRACCTM=$GET(^LRHY(69.87,LR6987,2))
+7 SET LRTKX=$GET(^LRHY(69.87,LR6987,6))
+8 SET LRARIVE=$GET(^LRHY(69.87,LR6987,8))
+9 KILL LRNCOL
+10 SET LR3D=$PIECE(LRDRAW1,".",2)
+11 IF $LENGTH(LR3D)'>3
SET LR3D=LR3D_"0"
+12 SET LR3D=$EXTRACT(LR3D,1,2)*60+$EXTRACT(LR3D,3,4)
+13 SET LR3T=$PIECE(LRACCTM,".",2)
+14 IF $LENGTH(LR3T)'>3
SET LR3T=LR3T_"0"
+15 SET LR3T=$EXTRACT(LR3T,1,2)*60+$EXTRACT(LR3T,3,4)
+16 SET LRTAT=(LR3D-LR3T)
+17 SET LRDRAW=$EXTRACT($PIECE(LRDRAW1,".",2),1,2)_":"_$EXTRACT($PIECE(LRDRAW1,".",2),3,4)
+18 SET LRARIVE=$EXTRACT($PIECE(LRACCTM,".",2),1,2)_":"_$EXTRACT($PIECE(LRACCTM,".",2),3,4)
+19 ;
+20 KILL LRDFN
+21 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
+22 KILL LRDPF
DO PT^LRX
+23 SET LRSSN=$PIECE(SSN,"-",3)
+24 SET LRAC1=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
+25 IF LRAC1=""
SET LRAC1=$EXTRACT($PIECE(^LRO(68,LRAA,0),U),1,2)_" "_$EXTRACT(LRAD,4,7)_" "_LRAN
+26 SET LRAANAME=$PIECE(^LRO(68,LRAA,0),U)
+27 ; check specimen not urine
+28 SET LRLLOC=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)
+29 SET LRSC0=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,13)
+30 IF $PIECE($GET(LRNCOL),U,4)
SET ^TMP("LRHYCOLLECTOR",$JOB,LRORDT_U_LRSN_U_LRUID,$PIECE(LRNCOL,U,4))=""
+31 KILL LRHYTECH
+32 SET LRHYTECH=$GET(^LRHY(69.87,LR6987,12))
+33 ;
+34 ;
+35 SET LRHYTECH=$GET(LRTKX)
+36 IF LRHYTECH
SET ^TMP("LRHYCOLLECTOR",$JOB,LRORDT_U_LRSN_U_LRUID,LRHYTECH)=""
+37 ;
+38 SET LRSTAR=0
+39 ;
+40 SET ^TMP("LRHYTATDALLAS",$JOB,$EXTRACT(LRDRAW,1,2),LRORDT_U_LRSN_U_LRUID)=LRDRAW_U_PNM_U_LRSSN_U_LRARIVE_U_LRTAT_U_LRAC1_U_$GET(LRSTAR)_U_$GET(LRLLOC)
End DoDot:1
+41 ;
+42 QUIT
+43 ;
DISP ;
+1 ;
+2 ;
+3 SET LRTOTAL=0
+4 SET LRHYCT=0
+5 USE IO
+6 SET LRD=0
+7 SET LR7MORE=0
+8 SET LR7LESS=0
+9 SET LR700=0
+10 NEW LRE,LRTECH,LREXLINE
+11 ;
+12 FOR
SET LRD=$ORDER(^TMP("LRHYTATDALLAS",$JOB,LRD))
IF +LRD'>0
QUIT
Begin DoDot:1
+13 SET LRE=""
+14 FOR
SET LRE=$ORDER(^TMP("LRHYTATDALLAS",$JOB,LRD,LRE))
IF +LRE'>0
QUIT
SET LRN=^(LRE)
Begin DoDot:2
+15 SET LRSN=$PIECE(LRE,U,2)
+16 SET LRDRAW=+LRN
+17 SET LRDRAW=$PIECE(LRN,U)
+18 SET PNM=$PIECE(LRN,U,2)
+19 SET LRSSN=$PIECE(LRN,U,3)
+20 SET LRARIVE=$PIECE(LRN,U,4)
+21 SET LRTAT=$PIECE(LRN,U,5)
+22 IF LRTAT>7
SET LR7MORE=LR7MORE+1
+23 IF LRTAT<7
SET LR7LESS=LR7LESS+1
+24 IF LRTAT=7
SET LR700=LR700+1
+25 SET LRAC1=$PIECE(LRN,U,6)
+26 SET LRTECH=$ORDER(^TMP("LRHYCOLLECTOR",$JOB,LRE,0))
+27 SET LREXLINE=$SELECT($LENGTH(LRTECH)>6:1,1:0)
+28 DO CHK
IF LRSTOP
QUIT
+29 KILL LREXLINE
+30 WRITE !,+$EXTRACT(LRD,1,2),?4,$EXTRACT(PNM,1,14)," ",LRSSN,?25,"BLD",?30,LRARIVE,?37,LRDRAW,?44,LRTAT
+31 WRITE ?49,LRTECH
+32 ;I $P(LRN,U,7)=1 W "*"
+33 IF $LENGTH(LRTECH)>6
WRITE !
+34 ;accession
WRITE ?56,LRAC1
+35 ;clinic
WRITE ?73,$EXTRACT($PIECE(LRN,U,8),1,7)
+36 SET LRHYCT=LRHYCT+1
SET LRTOTAL=LRTOTAL+LRTAT
+37 SET ^TMP("LRHYMEDTAT",$JOB,LRE)=LRTAT
End DoDot:2
End DoDot:1
+38 IF 'LRHYCT
QUIT
+39 WRITE !!,?10,"Mean TAT: "
+40 WRITE ?35,$PIECE(LRTOTAL/LRHYCT,".")_"."_$EXTRACT($PIECE(LRTOTAL/LRHYCT,".",2),1,1),?41
+41 DO MEDIAN
WRITE ?41," Minutes"
+42 WRITE !,?10,"Total Time: ",?35,LRTOTAL,?41," Minutes"
+43 WRITE !,?10,"Total Patients Drawn: ",?35,LRHYCT,!
+44 WRITE !,?15,"TAT > 7 minutes: ",LR7MORE
+45 WRITE !,?15,"TAT < 7 minutes: ",LR7LESS
+46 WRITE !,?15,"TAT = 7 minutes: ",LR700
+47 IF LRHYCT=0
SET LRHYCT=1
+48 ;
+49 ;
+50 WRITE !,?5,"Collectors: "
+51 SET LRN5=0
+52 FOR
SET LRN5=$ORDER(^TMP("LRHYCOLLECTOR",$JOB,LRN5))
IF +LRN5'>0
QUIT
Begin DoDot:1
+53 SET LRHYTECH=0
+54 FOR
SET LRHYTECH=$ORDER(^TMP("LRHYCOLLECTOR",$JOB,LRN5,LRHYTECH))
IF +LRHYTECH'>0
QUIT
Begin DoDot:2
+55 SET LRHYTECH1(LRHYTECH,LRN5)=""
End DoDot:2
End DoDot:1
+56 SET LRHYTECH=0
+57 FOR
SET LRHYTECH=$ORDER(LRHYTECH1(LRHYTECH))
IF +LRHYTECH'>0
QUIT
Begin DoDot:1
+58 SET LRHYCTC=0
SET LRT0=0
+59 FOR
SET LRT0=$ORDER(LRHYTECH1(LRHYTECH,LRT0))
IF +LRT0'>0
QUIT
Begin DoDot:2
+60 SET LRHYCTC=LRHYCTC+1
End DoDot:2
+61 IF $DATA(^VA(200,LRHYTECH))
WRITE !,?10,$PIECE(^VA(200,LRHYTECH,0),U)
+62 WRITE ?40,LRHYCTC,?45," Drawn"
End DoDot:1
+63 KILL DIR
IF IOST["C-"
SET DIR(0)="E"
DO ^DIR
+64 DO ^%ZISC
+65 QUIT
MEDIAN ;
+1 NEW LR334
SET LR334=0
+2 FOR
SET LR334=$ORDER(^TMP("LRHYMEDTAT",$JOB,LR334))
IF +LR334'>0
QUIT
IF +$GET(^TMP("LRHYMEDTAT",$JOB,LR334))'>0
SET ^TMP("LRHYMEDTAT",$JOB,LR334)=1
+3 SET LRSTUCK=0
+4 KILL ^TMP("LRHYMEDFINAL",$JOB)
+5 KILL LRTATN
+6 SET LRHYCT3=1
BAK SET LRX=0
SET LRKIL=0
SET LRNONONO=0
SET LRM3=0
+1 IF $DATA(^TMP("LRHYMEDFINAL",$JOB))
Begin DoDot:1
+2 IF '$DATA(^TMP("LRHYMEDFINAL",$JOB,LRHYCT3))
SET LRSTUCK=LRSTUCK+1
End DoDot:1
STUCK IF $GET(LRSTUCK)>2
KILL ^TMP("LRHYMEDTAT",$JOB,LRDUP)
SET LRSTUCK=0
+1 IF '$DATA(^TMP("LRHYMEDTAT",$JOB))
GOTO DONE
QUIT
+2 SET LRHYCT3=LRHYCT3+1
+3 SET LRM1=$ORDER(^TMP("LRHYMEDTAT",$JOB,LRX))
SET (LRX,LRDUP)=LRM1
+4 SET LRM1=$GET(^TMP("LRHYMEDTAT",$JOB,LRM1))
TIC FOR
SET LRX=$ORDER(^TMP("LRHYMEDTAT",$JOB,LRX))
IF +LRX'>0
QUIT
SET LRM2=^(LRX)
Begin DoDot:1
+1 SET LRKIL=LRX
+2 IF LRM2=LRM1
SET LRKIL=LRX
SET LRNOT=0
Begin DoDot:2
+3 FOR LRY=1:1:LRHYCT3
IF '$DATA(^TMP("LRHYMEDFINAL",$JOB,LRY))
QUIT
Begin DoDot:3
+4 IF LRM1>+$ORDER(^TMP("LRHYMEDFINAL",$JOB,LRY,0))
SET LRNOT=1
End DoDot:3
End DoDot:2
End DoDot:1
+5 KILL ^TMP("LRHYMEDTAT",$JOB,LRDUP)
SET LRKIL=LRX
+6 IF $GET(LRNOT)=1
SET LRX=LRX+.05
SET LRNOT=0
GOTO TIC
+7 IF LRKIL
KILL ^TMP("LRHYMEDTAT",$JOB,LRKIL)
+8 IF +$ORDER(^TMP("LRHYMEDTAT",$JOB,0))
GOTO BAK
+9 SET LRHYCT3=0
+10 SET LRX=0
+11 FOR
SET LRX=$ORDER(^TMP("LRHYMEDFINAL",$JOB,LRX))
IF +LRX'>0
QUIT
Begin DoDot:1
+12 SET LRHYCT3=LRHYCT3+1
+13 SET LRYTAT=$ORDER(^TMP("LRHYMEDFINAL",$JOB,LRX,0))
+14 SET LRTATN(LRHYCT3)=LRYTAT
End DoDot:1
+15 SET LRX=LRHYCT3/2
+16 IF 'LRX
QUIT
+17 IF LRX[.5
SET LRX1=$PIECE(LRX,".")
IF 'LRX1
QUIT
SET LRX2=LRX1+1
Begin DoDot:1
+18 SET LRX3=(LRTATN(LRX1)+LRTATN(LRX2))/2
End DoDot:1
+19 IF '$TEST
SET LRX3=LRTATN(LRX)
+20 WRITE !,?10,"Median TAT:",?35,LRX3
+21 ;
+22 QUIT
HEAD ;
+1 SET LRSTOP=0
+2 WRITE @IOF
+3 WRITE "Date:",$$Y2K^LRX(DT)," ",$$CJ^XLFSTR("PATIENT WAIT TIME",IOM)
+4 WRITE !,"Time",?5,"Patient Name",?25,"Type",?30,"Arrive"
+5 WRITE ?37,"Drawn",?44,"TAT",?49,"TECH",?57,"ACCN"
+6 WRITE ?73,"Clinic"
+7 QUIT
CHK ;
+1 IF LRSTOP
QUIT
+2 SET LRLINE=(IOSL-$Y)
+3 IF $EXTRACT(IOST,1,2)["P-"
Begin DoDot:1
+4 IF LRLINE<(7+$GET(LREXLINE))
DO HEAD
QUIT
End DoDot:1
QUIT
+5 ;
+6 IF LRLINE<(2+$GET(LREXLINE))
Begin DoDot:1
+7 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+8 KILL DIR
SET DIR(0)="E"
DO ^DIR
+9 IF $DATA(DUOUT)!($DATA(DIRUT))
SET LRSTOP=1
QUIT
+10 DO HEAD
End DoDot:1
+11 QUIT
DONE ;
+1 SET LRHYCT3=0
+2 SET LRX=0
+3 FOR
SET LRX=$ORDER(^TMP("LRHYMEDFINAL",$JOB,LRX))
IF +LRX'>0
QUIT
Begin DoDot:1
+4 SET LRHYCT3=LRHYCT3+1
+5 SET LRYTAT=$ORDER(^TMP("LRHYMEDFINAL",$JOB,LRX,0))
+6 SET LRTATN(LRHYCT3)=LRYTAT
End DoDot:1
+7 SET LRX=LRHYCT3/2
+8 IF LRX[.5
SET LRX1=$PIECE(LRX,".")
IF 'LRX1
QUIT
SET LRX2=LRX1+1
Begin DoDot:1
+9 SET LRX3=(LRTATN(LRX1)+LRTATN(LRX2))/2
End DoDot:1
+10 IF '$TEST
SET LRX3=LRTATN(LRX)
+11 WRITE !,?10,"Median TAT:",?35,LRX3
+12 QUIT
DEVICE ;
+1 SET ZTRTN="Q^LRHY4X"
+2 ;
+3 DO IO^LRWU
+4 ;
+5 QUIT
+6 QUIT
