- LRHY4X ;DALOI/HOAK - PHLEBOTOMY TAT ; 12/1/16 11:20am
- ;;5.2;LAB SERVICE;**405,417,430,478**;Sep 27, 1994;Build 2
- ;
- ;
- 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=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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHY4X 7110 printed Feb 18, 2025@23:41:02 Page 2
- LRHY4X ;DALOI/HOAK - PHLEBOTOMY TAT ; 12/1/16 11:20am
- +1 ;;5.2;LAB SERVICE;**405,417,430,478**;Sep 27, 1994;Build 2
- +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=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