Routine: LRHYF4

LRHYF4 ;DALOI/HOAK - PHLEBOTOMY TAT ;12/10/10 6:00pm

 ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93

 ; Reference to ^DIC supported by DBIA #916.

START ;

G ;

 K ^TMP("LRHYMEDTAT",$J)

 K ^TMP("LRHYCOLLECTOR",$J)

 K ^TMP("LRHYTATDALLAS",$J)

 K ^TMP("LRHYMEDTAT",$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("LRHYTATDALLAS",$J)

 K ^TMP("LRHYCOLLECTOR",$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))

 .. Q:'$O(^LRO(68,"C",LRUID,0))

 ..  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 ;

 ; GET UID

 ; GET IEN IN 69.87

 S LRIEN=$O(^LRHY(69.87,"B",LRUID,0)) Q:'LRIEN

 .  K LRARIVE

 .  S LREND=0

 .  S LRSN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5)

 .  S LRACCTM=$P(^LRHY(69.87,LRIEN,8),U)

 .  S LRARIVE=$P(^LRHY(69.87,LRIEN,10),U)

 .  S LRTKX=$G(^LRHY(69.87,LRIEN,6))

 .  K LRNCOL

 .  S LRACCTM=$P(^TMP("LRHYHOW1",$J,LRUID),U)

 .  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=$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,LRSN,$P(LRNCOL,U,4))=""

 .  K LRHYTECH

 .  S LRHYTECH=$P(^TMP("LRHYHOW1",$J,LRUID),U,11)

 .  S LRHYTECH=$G(LRTKX)

 .  I LRHYTECH S ^TMP("LRHYCOLLECTOR",$J,LRSN,LRHYTECH)=""

 .  S LRSTAR=0

 .  S ^TMP("LRHYTATDALLAS",$J,$E(LRDRAW,1,2),LRSN)=LRDRAW_U_PNM_U_LRSSN_U

 .  S ^TMP("LRHYTATDALLAS",$J,$E(LRDRAW,1,2),LRSN)=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

 F  S LRD=$O(^TMP("LRHYTATDALLAS",$J,LRD)) Q:+LRD'>0  D

 .  S LRSN=0

 .  F  S LRSN=$O(^TMP("LRHYTATDALLAS",$J,LRD,LRSN)) Q:+LRSN'>0  S LRN=^(LRSN) D

 ..  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)

 ..  D CHK Q:LRSTOP

 ..  W !,+$E(LRD,1,2),?5,$E(PNM,1,15)," ",LRSSN,?27,"BLD",?32,LRARIVE,?40,LRDRAW,?47,LRTAT

 ..  W ?52,$O(^TMP("LRHYCOLLECTOR",$J,LRSN,0))

 ..  I $P(LRN,U,7)=1 W "*"

 ..  W ?59,LRAC1 ;accession

 ..  W ?72,$E($P(LRN,U,8),1,8) ;clinic

 ..  S LRHYCT=LRHYCT+1 S LRTOTAL=LRTOTAL+LRTAT

 ..  S ^TMP("LRHYMEDTAT",$J,LRSN)=LRTAT

 Q:'LRHYCT

 W !!,?10,"Mean TAT: "

 W ?35,$P(LRTOTAL/LRHYCT,".")_"."_$E($P(LRTOTAL/LRHYCT,".",2),1,1),?41," Minutes"

 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

 .  W !,?10,$P(^VA(200,LRHYTECH,0),U)

 .  W ?40,LRHYCTC,?45," Drawn"

 K DIR I IOST["C-" S DIR(0)="E" D ^DIR

 K DIR

 D ^%ZISC

 QUIT

MEDIAN ;

 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

 .  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

 ...  I 'LRNOT  D

 ....  K ^TMP("LRHYMEDTAT",$J,LRDUP) S LRKIL=LRX

 .  I LRM2>LRM1 S LRKIL=LRX S LRM1=LRM2

 Q:'$G(LRX)

 I $G(LRNOT)=1 S LRX=LRX+.05 S LRNOT=0 G TIC

 I LRKIL S ^TMP("LRHYMEDFINAL",$J,LRHYCT3,^TMP("LRHYMEDTAT",$J,LRKIL))=""

 I LRKIL K ^TMP("LRHYMEDTAT",$J,LRKIL)

 K ^TMP("LRHYMEDTAT",$J,LRX) G BAK

 I +$O(^TMP("LRHYMEDTAT",$J,0)) G BAK

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

HEAD ;

 S LRSTOP=0

 W @IOF

 W "Date:",$$CJ^XLFSTR("PATIENT WAIT TIME",IOM)

 W !,"Time",?5,"Patient Name",?27,"Type",?32,"Arrived"

 W ?40,"Drawn",?47,"TAT",?52,"TECH",?60,"ACCN"

 W ?72,"Clinic"

 QUIT

CHK ;

 Q:LRSTOP

 S LRLINE=(IOSL-$Y)

 I $E(IOST,1,2)["P-" D  QUIT

 .  I LRLINE<7 D HEAD QUIT

 I LRLINE<2 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

DEVICE ;

 S ZTRTN="Q^LRHYF4"

 D IO^LRWU

 QUIT

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYF4   6560     printed  Mar 13, 2025@21:19:40                                                                                                                                                                                                      Page 2

LRHYF4    ;DALOI/HOAK - PHLEBOTOMY TAT ;12/10/10 6:00pm

 +1       ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93

 +2       ;

 +3       ; Reference to ^DIC supported by DBIA #916.

START     ;

 +1       ;

G         ;

 +1        KILL ^TMP("LRHYMEDTAT",$JOB)

 +2       ;

 +3        KILL ^TMP("LRHYCOLLECTOR",$JOB)

 +4       ;

 +5        KILL ^TMP("LRHYTATDALLAS",$JOB)

 +6        KILL ^TMP("LRHYMEDTAT",$JOB)

 +7        KILL LRHYTECH1

 +8        KILL %DT

 +9        SET %DT="AET"

 +10       SET %DT("A")="Please enter date and time to start search: "

 +11       DO ^%DT

 +12       if Y=-1

               QUIT

 +13       SET LRSDT=Y

 +14       SET LRODT=$PIECE(LRSDT,".")

 +15       SET %DT("A")="Please enter date and time to end search: "

 +16       DO ^%DT

 +17       if Y=-1

               QUIT

 +18       SET LREDT=Y

 +19       DO DEVICE

 +20       KILL ^TMP("LRHYMEDTAT",$JOB),^TMP("LRHYMEDFINAL",$JOB)

 +21       KILL ^TMP("LRHYTATDALLAS",$JOB)

 +22       KILL ^TMP("LRHYCOLLECTOR",$JOB)

 +23       QUIT

PAT       ;

 +1        SET LREND=0

 +2        SET DIC="^DPT("

 +3        SET DIC(0)="AEMQZ"

 +4        DO ^DIC

 +5        SET DFN=+Y

 +6        SET LRDFN=$GET(^DPT(DFN,"LR"))

 +7        DO ^VADPT

           DO INP^VADPT

 +8       ;

 +9        QUIT

 +10      ;

LRO69     ;

Q         ;

 +1       ;

 +2        USE IO

 +3        SET LREND=0

 +4        SET LRSTAR=0

 +5        DO HEAD

 +6        SET LRSN=0

 +7        SET LRSTOP=0

 +8        SET LRDRAW1=LRODT

 +9        FOR

               SET LRDRAW1=$ORDER(^LRHY(69.87,"COLT",LRDRAW1))

               if +LRDRAW1'>0!(LRDRAW1>LREDT)!(LRSTOP)

                   QUIT

               Begin DoDot:1

 +10               SET LRUID=""

 +11               FOR

                       SET LRUID=$ORDER(^LRHY(69.87,"COLT",LRDRAW1,LRUID))

                       if LRUID=""

                           QUIT

                       Begin DoDot:2

 +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       ; GET UID

 +2       ; GET IEN IN 69.87

 +3        SET LRIEN=$ORDER(^LRHY(69.87,"B",LRUID,0))

           if 'LRIEN

               QUIT

 +4        Begin DoDot:1

 +5            KILL LRARIVE

 +6            SET LREND=0

 +7            SET LRSN=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5)

 +8            SET LRACCTM=$PIECE(^LRHY(69.87,LRIEN,8),U)

 +9            SET LRARIVE=$PIECE(^LRHY(69.87,LRIEN,10),U)

 +10           SET LRTKX=$GET(^LRHY(69.87,LRIEN,6))

 +11           KILL LRNCOL

 +12           SET LRACCTM=$PIECE(^TMP("LRHYHOW1",$JOB,LRUID),U)

 +13           SET LR3D=$PIECE(LRDRAW1,".",2)

 +14           IF $LENGTH(LR3D)'>3

                   SET LR3D=LR3D_"0"

 +15           SET LR3D=$EXTRACT(LR3D,1,2)*60+$EXTRACT(LR3D,3,4)

 +16           SET LR3T=$PIECE(LRACCTM,".",2)

 +17           IF $LENGTH(LR3T)'>3

                   SET LR3T=LR3T_"0"

 +18           SET LR3T=$EXTRACT(LR3T,1,2)*60+$EXTRACT(LR3T,3,4)

 +19           SET LRTAT=(LR3D-LR3T)

 +20           SET LRDRAW=$EXTRACT($PIECE(LRDRAW1,".",2),1,2)_":"_$EXTRACT($PIECE(LRDRAW1,".",2),3,4)

 +21           SET LRARIVE=$EXTRACT($PIECE(LRACCTM,".",2),1,2)_":"_$EXTRACT($PIECE(LRACCTM,".",2),3,4)

 +22           KILL LRDFN

 +23           SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)

 +24           KILL LRDPF

               DO PT^LRX

 +25           SET LRSSN=$PIECE(SSN,"-",3)

 +26           SET LRAC1=$EXTRACT($PIECE(^LRO(68,LRAA,0),U),1,2)_" "_$EXTRACT(LRAD,4,7)_" "_LRAN

 +27           SET LRAANAME=$PIECE(^LRO(68,LRAA,0),U)

 +28      ;  check specimen not urine

 +29           SET LRLLOC=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)

 +30           SET LRSC0=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,13)

 +31           IF $PIECE($GET(LRNCOL),U,4)

                   SET ^TMP("LRHYCOLLECTOR",$JOB,LRSN,$PIECE(LRNCOL,U,4))=""

 +32           KILL LRHYTECH

 +33           SET LRHYTECH=$PIECE(^TMP("LRHYHOW1",$JOB,LRUID),U,11)

 +34           SET LRHYTECH=$GET(LRTKX)

 +35           IF LRHYTECH

                   SET ^TMP("LRHYCOLLECTOR",$JOB,LRSN,LRHYTECH)=""

 +36           SET LRSTAR=0

 +37           SET ^TMP("LRHYTATDALLAS",$JOB,$EXTRACT(LRDRAW,1,2),LRSN)=LRDRAW_U_PNM_U_LRSSN_U

 +38           SET ^TMP("LRHYTATDALLAS",$JOB,$EXTRACT(LRDRAW,1,2),LRSN)=LRDRAW_U_PNM_U_LRSSN_U_LRARIVE_U_LRTAT_U_LRAC1_U_$GET(LRSTAR)_U_$GET(LRLLOC)

           End DoDot:1

 +39      ;

 +40       QUIT

 +41      ;

DISP      ;

 +1        SET LRTOTAL=0

 +2        SET LRHYCT=0

 +3        USE IO

 +4        SET LRD=0

 +5        SET LR7MORE=0

 +6        SET LR7LESS=0

 +7        SET LR700=0

 +8        FOR

               SET LRD=$ORDER(^TMP("LRHYTATDALLAS",$JOB,LRD))

               if +LRD'>0

                   QUIT

               Begin DoDot:1

 +9                SET LRSN=0

 +10               FOR

                       SET LRSN=$ORDER(^TMP("LRHYTATDALLAS",$JOB,LRD,LRSN))

                       if +LRSN'>0

                           QUIT

                       SET LRN=^(LRSN)

                       Begin DoDot:2

 +11                       SET LRDRAW=+LRN

 +12                       SET LRDRAW=$PIECE(LRN,U)

 +13                       SET PNM=$PIECE(LRN,U,2)

 +14                       SET LRSSN=$PIECE(LRN,U,3)

 +15                       SET LRARIVE=$PIECE(LRN,U,4)

 +16                       SET LRTAT=$PIECE(LRN,U,5)

 +17                       IF LRTAT>7

                               SET LR7MORE=LR7MORE+1

 +18                       IF LRTAT<7

                               SET LR7LESS=LR7LESS+1

 +19                       IF LRTAT=7

                               SET LR700=LR700+1

 +20                       SET LRAC1=$PIECE(LRN,U,6)

 +21                       DO CHK

                           if LRSTOP

                               QUIT

 +22                       WRITE !,+$EXTRACT(LRD,1,2),?5,$EXTRACT(PNM,1,15)," ",LRSSN,?27,"BLD",?32,LRARIVE,?40,LRDRAW,?47,LRTAT

 +23                       WRITE ?52,$ORDER(^TMP("LRHYCOLLECTOR",$JOB,LRSN,0))

 +24                       IF $PIECE(LRN,U,7)=1

                               WRITE "*"

 +25      ;accession

                           WRITE ?59,LRAC1

 +26      ;clinic

                           WRITE ?72,$EXTRACT($PIECE(LRN,U,8),1,8)

 +27                       SET LRHYCT=LRHYCT+1

                           SET LRTOTAL=LRTOTAL+LRTAT

 +28                       SET ^TMP("LRHYMEDTAT",$JOB,LRSN)=LRTAT

                       End DoDot:2

               End DoDot:1

 +29       if 'LRHYCT

               QUIT

 +30       WRITE !!,?10,"Mean TAT: "

 +31       WRITE ?35,$PIECE(LRTOTAL/LRHYCT,".")_"."_$EXTRACT($PIECE(LRTOTAL/LRHYCT,".",2),1,1),?41," Minutes"

 +32       DO MEDIAN

           WRITE ?41," Minutes"

 +33       WRITE !,?10,"Total Time: ",?35,LRTOTAL,?41," Minutes"

 +34       WRITE !,?10,"Total Patients Drawn: ",?35,LRHYCT,!

 +35       WRITE !,?15,"TAT > 7 minutes: ",LR7MORE

 +36       WRITE !,?15,"TAT < 7 minutes: ",LR7LESS

 +37       WRITE !,?15,"TAT = 7 minutes: ",LR700

 +38       IF LRHYCT=0

               SET LRHYCT=1

 +39       WRITE !,?5,"Collectors: "

 +40       SET LRN5=0

 +41       FOR

               SET LRN5=$ORDER(^TMP("LRHYCOLLECTOR",$JOB,LRN5))

               if +LRN5'>0

                   QUIT

               Begin DoDot:1

 +42               SET LRHYTECH=0

 +43               FOR

                       SET LRHYTECH=$ORDER(^TMP("LRHYCOLLECTOR",$JOB,LRN5,LRHYTECH))

                       if +LRHYTECH'>0

                           QUIT

                       Begin DoDot:2

 +44                       SET LRHYTECH1(LRHYTECH,LRN5)=""

                       End DoDot:2

               End DoDot:1

 +45       SET LRHYTECH=0

 +46       FOR

               SET LRHYTECH=$ORDER(LRHYTECH1(LRHYTECH))

               if +LRHYTECH'>0

                   QUIT

               Begin DoDot:1

 +47               SET LRHYCTC=0

                   SET LRT0=0

 +48               FOR

                       SET LRT0=$ORDER(LRHYTECH1(LRHYTECH,LRT0))

                       if +LRT0'>0

                           QUIT

                       Begin DoDot:2

 +49                       SET LRHYCTC=LRHYCTC+1

                       End DoDot:2

 +50               WRITE !,?10,$PIECE(^VA(200,LRHYTECH,0),U)

 +51               WRITE ?40,LRHYCTC,?45," Drawn"

               End DoDot:1

 +52       KILL DIR

           IF IOST["C-"

               SET DIR(0)="E"

               DO ^DIR

 +53       KILL DIR

 +54       DO ^%ZISC

 +55       QUIT

MEDIAN    ;

 +1        SET LRSTUCK=0

 +2        KILL ^TMP("LRHYMEDFINAL",$JOB)

 +3        KILL LRTATN

 +4        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                IF LRM2=LRM1

                       SET LRKIL=LRX

                       SET LRNOT=0

                       Begin DoDot:2

 +2                        FOR LRY=1:1:LRHYCT3

                               if '$DATA(^TMP("LRHYMEDFINAL",$JOB,LRY))

                                   QUIT

                               Begin DoDot:3

 +3                                IF LRM1>+$ORDER(^TMP("LRHYMEDFINAL",$JOB,LRY,0))

                                       SET LRNOT=1

 +4                                IF 'LRNOT

                                       Begin DoDot:4

 +5                                        KILL ^TMP("LRHYMEDTAT",$JOB,LRDUP)

                                           SET LRKIL=LRX

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +6                IF LRM2>LRM1

                       SET LRKIL=LRX

                       SET LRM1=LRM2

               End DoDot:1

 +7        if '$GET(LRX)

               QUIT

 +8        IF $GET(LRNOT)=1

               SET LRX=LRX+.05

               SET LRNOT=0

               GOTO TIC

 +9        IF LRKIL

               SET ^TMP("LRHYMEDFINAL",$JOB,LRHYCT3,^TMP("LRHYMEDTAT",$JOB,LRKIL))=""

 +10       IF LRKIL

               KILL ^TMP("LRHYMEDTAT",$JOB,LRKIL)

 +11       KILL ^TMP("LRHYMEDTAT",$JOB,LRX)

           GOTO BAK

 +12       IF +$ORDER(^TMP("LRHYMEDTAT",$JOB,0))

               GOTO BAK

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      ;

 +13       QUIT

HEAD      ;

 +1        SET LRSTOP=0

 +2        WRITE @IOF

 +3        WRITE "Date:",$$CJ^XLFSTR("PATIENT WAIT TIME",IOM)

 +4        WRITE !,"Time",?5,"Patient Name",?27,"Type",?32,"Arrived"

 +5        WRITE ?40,"Drawn",?47,"TAT",?52,"TECH",?60,"ACCN"

 +6        WRITE ?72,"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

                       DO HEAD

                       QUIT

               End DoDot:1

               QUIT

 +5       ;

 +6        IF LRLINE<2

               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

DEVICE    ;

 +1        SET ZTRTN="Q^LRHYF4"

 +2       ;

 +3        DO IO^LRWU

 +4       ;

 +5        QUIT

 +6        QUIT

LRHYF4.m