Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRHY4X

LRHY4X.m

Go to the documentation of this file.
  1. LRHY4X ;DALOI/HOAK - PHLEBOTOMY TAT ; 12/1/16 11:20am
  1. ;;5.2;LAB SERVICE;**405,417,430,478**;Sep 27, 1994;Build 2
  1. ;
  1. ;
  1. START ;
  1. ;
  1. G ;
  1. K ^TMP("LRHYMEDTAT",$J)
  1. ;
  1. K ^TMP("LRHYCOLLECTOR",$J)
  1. ;
  1. K ^TMP("LRHYTATDALLAS",$J)
  1. K LRHYTECH1
  1. K %DT
  1. S %DT="AET"
  1. S %DT("A")="Please enter date and time to start search: "
  1. D ^%DT
  1. Q:Y=-1
  1. S LRSDT=Y
  1. S LRODT=LRSDT
  1. S %DT("A")="Please enter date and time to end search: "
  1. D ^%DT
  1. Q:Y=-1
  1. S LREDT=Y
  1. ;
  1. D DEVICE
  1. K ^TMP("LRHYMEDTAT",$J),^TMP("LRHYMEDFINAL",$J)
  1. K ^TMP("LRHYCOLLECTOR",$J),^TMP("LRHYTATDALLAS",$J)
  1. QUIT
  1. PAT ;
  1. ;
  1. ;
  1. S LREND=0
  1. S DIC="^DPT("
  1. S DIC(0)="AEMQZ"
  1. D ^DIC
  1. S DFN=+Y
  1. S LRDFN=$G(^DPT(DFN,"LR"))
  1. D ^VADPT,INP^VADPT
  1. ;
  1. QUIT
  1. ;
  1. LRO69 ;
  1. Q ;
  1. U IO
  1. S LREND=0
  1. S LRSTAR=0
  1. D HEAD
  1. S LRSN=0
  1. S LRSTOP=0
  1. S LRDRAW1=LRODT
  1. F S LRDRAW1=$O(^LRHY(69.87,"COLT",LRDRAW1)) Q:+LRDRAW1'>0!(LRDRAW1>LREDT)!(LRSTOP) D
  1. . S LRUID=""
  1. . F S LRUID=$O(^LRHY(69.87,"COLT",LRDRAW1,LRUID)) Q:LRUID="" D
  1. .. ;
  1. .. S LRUID=$G(^LRHY(69.87,LRUID,0))
  1. .. I '$O(^LRO(68,"C",LRUID,0)) QUIT
  1. .. S LRAA=$O(^LRO(68,"C",LRUID,0))
  1. .. S LRAD=$O(^LRO(68,"C",LRUID,LRAA,0))
  1. .. S LRAN=$O(^LRO(68,"C",LRUID,LRAA,LRAD,0))
  1. .. D IN
  1. D DISP
  1. QUIT
  1. IN ;
  1. S LR6987=$O(^LRHY(69.87,"B",LRUID,0)) Q:'$G(LR6987)
  1. D
  1. . S LREND=0
  1. . K LRARIVE
  1. . 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)
  1. . S LRACCTM=$G(^LRHY(69.87,LR6987,2))
  1. . S LRTKX=$G(^LRHY(69.87,LR6987,6))
  1. . S LRARIVE=$G(^LRHY(69.87,LR6987,8))
  1. . K LRNCOL
  1. . S LR3D=$P(LRDRAW1,".",2)
  1. . I $L(LR3D)'>3 S LR3D=LR3D_"0"
  1. . S LR3D=$E(LR3D,1,2)*60+$E(LR3D,3,4)
  1. . S LR3T=$P(LRACCTM,".",2)
  1. . I $L(LR3T)'>3 S LR3T=LR3T_"0"
  1. . S LR3T=$E(LR3T,1,2)*60+$E(LR3T,3,4)
  1. . S LRTAT=(LR3D-LR3T)
  1. . S LRDRAW=$E($P(LRDRAW1,".",2),1,2)_":"_$E($P(LRDRAW1,".",2),3,4)
  1. . S LRARIVE=$E($P(LRACCTM,".",2),1,2)_":"_$E($P(LRACCTM,".",2),3,4)
  1. . ;
  1. . K LRDFN
  1. . S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
  1. . K LRDPF D PT^LRX
  1. . S LRSSN=$P(SSN,"-",3)
  1. . S LRAC1=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
  1. . I LRAC1="" S LRAC1=$E($P(^LRO(68,LRAA,0),U),1,2)_" "_$E(LRAD,4,7)_" "_LRAN
  1. . S LRAANAME=$P(^LRO(68,LRAA,0),U)
  1. . ; check specimen not urine
  1. . S LRLLOC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)
  1. . S LRSC0=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,13)
  1. . I $P($G(LRNCOL),U,4) S ^TMP("LRHYCOLLECTOR",$J,LRORDT_U_LRSN_U_LRUID,$P(LRNCOL,U,4))=""
  1. . K LRHYTECH
  1. . S LRHYTECH=$G(^LRHY(69.87,LR6987,12))
  1. . ;
  1. . ;
  1. . S LRHYTECH=$G(LRTKX)
  1. . I LRHYTECH S ^TMP("LRHYCOLLECTOR",$J,LRORDT_U_LRSN_U_LRUID,LRHYTECH)=""
  1. . ;
  1. . S LRSTAR=0
  1. . ;
  1. . 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)
  1. ;
  1. QUIT
  1. ;
  1. DISP ;
  1. ;
  1. ;
  1. S LRTOTAL=0
  1. S LRHYCT=0
  1. U IO
  1. S LRD=0
  1. S LR7MORE=0
  1. S LR7LESS=0
  1. S LR700=0
  1. N LRE,LRTECH,LREXLINE
  1. ;
  1. F S LRD=$O(^TMP("LRHYTATDALLAS",$J,LRD)) Q:+LRD'>0 D
  1. . S LRE=""
  1. . F S LRE=$O(^TMP("LRHYTATDALLAS",$J,LRD,LRE)) Q:+LRE'>0 S LRN=^(LRE) D
  1. .. S LRSN=$P(LRE,U,2)
  1. .. S LRDRAW=+LRN
  1. .. S LRDRAW=$P(LRN,U)
  1. .. S PNM=$P(LRN,U,2)
  1. .. S LRSSN=$P(LRN,U,3)
  1. .. S LRARIVE=$P(LRN,U,4)
  1. .. S LRTAT=$P(LRN,U,5)
  1. .. I LRTAT>7 S LR7MORE=LR7MORE+1
  1. .. I LRTAT<7 S LR7LESS=LR7LESS+1
  1. .. I LRTAT=7 S LR700=LR700+1
  1. .. S LRAC1=$P(LRN,U,6)
  1. .. S LRTECH=$O(^TMP("LRHYCOLLECTOR",$J,LRE,0))
  1. .. S LREXLINE=$S($L(LRTECH)>6:1,1:0)
  1. .. D CHK Q:LRSTOP
  1. .. K LREXLINE
  1. .. W !,+$E(LRD,1,2),?4,$E(PNM,1,14)," ",LRSSN,?25,"BLD",?30,LRARIVE,?37,LRDRAW,?44,LRTAT
  1. .. W ?49,LRTECH
  1. .. ;I $P(LRN,U,7)=1 W "*"
  1. .. I $L(LRTECH)>6 W !
  1. .. W ?56,LRAC1 ;accession
  1. .. W ?73,$E($P(LRN,U,8),1,7) ;clinic
  1. .. S LRHYCT=LRHYCT+1 S LRTOTAL=LRTOTAL+LRTAT
  1. .. S ^TMP("LRHYMEDTAT",$J,LRE)=LRTAT
  1. Q:'LRHYCT
  1. W !!,?10,"Mean TAT: "
  1. W ?35,$P(LRTOTAL/LRHYCT,".")_"."_$E($P(LRTOTAL/LRHYCT,".",2),1,1),?41
  1. D MEDIAN W ?41," Minutes"
  1. W !,?10,"Total Time: ",?35,LRTOTAL,?41," Minutes"
  1. W !,?10,"Total Patients Drawn: ",?35,LRHYCT,!
  1. W !,?15,"TAT > 7 minutes: ",LR7MORE
  1. W !,?15,"TAT < 7 minutes: ",LR7LESS
  1. W !,?15,"TAT = 7 minutes: ",LR700
  1. I LRHYCT=0 S LRHYCT=1
  1. ;
  1. ;
  1. W !,?5,"Collectors: "
  1. S LRN5=0
  1. F S LRN5=$O(^TMP("LRHYCOLLECTOR",$J,LRN5)) Q:+LRN5'>0 D
  1. . S LRHYTECH=0
  1. . F S LRHYTECH=$O(^TMP("LRHYCOLLECTOR",$J,LRN5,LRHYTECH)) Q:+LRHYTECH'>0 D
  1. .. S LRHYTECH1(LRHYTECH,LRN5)=""
  1. S LRHYTECH=0
  1. F S LRHYTECH=$O(LRHYTECH1(LRHYTECH)) Q:+LRHYTECH'>0 D
  1. . S LRHYCTC=0 S LRT0=0
  1. . F S LRT0=$O(LRHYTECH1(LRHYTECH,LRT0)) Q:+LRT0'>0 D
  1. .. S LRHYCTC=LRHYCTC+1
  1. . I $D(^VA(200,LRHYTECH)) W !,?10,$P(^VA(200,LRHYTECH,0),U)
  1. . W ?40,LRHYCTC,?45," Drawn"
  1. K DIR I IOST["C-" S DIR(0)="E" D ^DIR
  1. D ^%ZISC
  1. QUIT
  1. MEDIAN ;
  1. N LR334 S LR334=0
  1. F S LR334=$O(^TMP("LRHYMEDTAT",$J,LR334)) Q:+LR334'>0 I +$G(^TMP("LRHYMEDTAT",$J,LR334))'>0 S ^TMP("LRHYMEDTAT",$J,LR334)=1
  1. S LRSTUCK=0
  1. K ^TMP("LRHYMEDFINAL",$J)
  1. K LRTATN
  1. S LRHYCT3=1
  1. BAK S LRX=0 S LRKIL=0 S LRNONONO=0 S LRM3=0
  1. I $D(^TMP("LRHYMEDFINAL",$J)) D
  1. . I '$D(^TMP("LRHYMEDFINAL",$J,LRHYCT3)) S LRSTUCK=LRSTUCK+1
  1. STUCK I $G(LRSTUCK)>2 K ^TMP("LRHYMEDTAT",$J,LRDUP) S LRSTUCK=0
  1. I '$D(^TMP("LRHYMEDTAT",$J)) G DONE QUIT
  1. S LRHYCT3=LRHYCT3+1
  1. S LRM1=$O(^TMP("LRHYMEDTAT",$J,LRX)) S (LRX,LRDUP)=LRM1
  1. S LRM1=$G(^TMP("LRHYMEDTAT",$J,LRM1))
  1. TIC F S LRX=$O(^TMP("LRHYMEDTAT",$J,LRX)) Q:+LRX'>0 S LRM2=^(LRX) D
  1. . S LRKIL=LRX
  1. . I LRM2=LRM1 S LRKIL=LRX S LRNOT=0 D
  1. .. F LRY=1:1:LRHYCT3 Q:'$D(^TMP("LRHYMEDFINAL",$J,LRY)) D
  1. ... I LRM1>+$O(^TMP("LRHYMEDFINAL",$J,LRY,0)) S LRNOT=1
  1. K ^TMP("LRHYMEDTAT",$J,LRDUP) S LRKIL=LRX
  1. I $G(LRNOT)=1 S LRX=LRX+.05 S LRNOT=0 G TIC
  1. I LRKIL K ^TMP("LRHYMEDTAT",$J,LRKIL)
  1. I +$O(^TMP("LRHYMEDTAT",$J,0)) G BAK
  1. S LRHYCT3=0
  1. S LRX=0
  1. F S LRX=$O(^TMP("LRHYMEDFINAL",$J,LRX)) Q:+LRX'>0 D
  1. . S LRHYCT3=LRHYCT3+1
  1. . S LRYTAT=$O(^TMP("LRHYMEDFINAL",$J,LRX,0))
  1. . S LRTATN(LRHYCT3)=LRYTAT
  1. S LRX=LRHYCT3/2
  1. Q:'LRX
  1. I LRX[.5 S LRX1=$P(LRX,".") Q:'LRX1 S LRX2=LRX1+1 D
  1. . S LRX3=(LRTATN(LRX1)+LRTATN(LRX2))/2
  1. E S LRX3=LRTATN(LRX)
  1. W !,?10,"Median TAT:",?35,LRX3
  1. ;
  1. QUIT
  1. S LRSTOP=0
  1. W @IOF
  1. W "Date:",$$Y2K^LRX(DT)," ",$$CJ^XLFSTR("PATIENT WAIT TIME",IOM)
  1. W !,"Time",?5,"Patient Name",?25,"Type",?30,"Arrive"
  1. W ?37,"Drawn",?44,"TAT",?49,"TECH",?57,"ACCN"
  1. W ?73,"Clinic"
  1. QUIT
  1. CHK ;
  1. Q:LRSTOP
  1. S LRLINE=(IOSL-$Y)
  1. I $E(IOST,1,2)["P-" D QUIT
  1. . I LRLINE<(7+$G(LREXLINE)) D HEAD QUIT
  1. ;
  1. I LRLINE<(2+$G(LREXLINE)) D
  1. . Q:$E(IOST,1,2)'["C-"
  1. . K DIR S DIR(0)="E" D ^DIR
  1. . I $D(DUOUT)!($D(DIRUT)) S LRSTOP=1 Q
  1. . D HEAD
  1. QUIT
  1. DONE ;
  1. S LRHYCT3=0
  1. S LRX=0
  1. F S LRX=$O(^TMP("LRHYMEDFINAL",$J,LRX)) Q:+LRX'>0 D
  1. . S LRHYCT3=LRHYCT3+1
  1. . S LRYTAT=$O(^TMP("LRHYMEDFINAL",$J,LRX,0))
  1. . S LRTATN(LRHYCT3)=LRYTAT
  1. S LRX=LRHYCT3/2
  1. I LRX[.5 S LRX1=$P(LRX,".") Q:'LRX1 S LRX2=LRX1+1 D
  1. . S LRX3=(LRTATN(LRX1)+LRTATN(LRX2))/2
  1. E S LRX3=LRTATN(LRX)
  1. W !,?10,"Median TAT:",?35,LRX3
  1. QUIT
  1. DEVICE ;
  1. S ZTRTN="Q^LRHY4X"
  1. ;
  1. D IO^LRWU
  1. ;
  1. QUIT
  1. QUIT