LRTT5R1 ;DALISC/FHS - LAB URGENCY TURNAROUND TIMES REPORT GENERATOR ; 12/3/1997
;;5.2;LAB SERVICE;**153,201,274**;Sep 27, 1994
ONE ; from LRTT5
; input LRPQ(, ^TMP("LR",$J processed from LRTT5P1
S LREND=0
I $O(LRLLOC(0)) W !?10," Institution included in report:" D
. S I=0 F S I=$O(LRLLOC(I)) Q:I<1 W !?20,$P(LRLLOC(I),U,2)
F LRPTYPE="REG","IRREG" D W !
.W !," Turnaround Time (TAT) - ",$S(LRPTYPE="REG":"Regular (0701-1700) ",1:"Irregular")," hours",!
.W !," Number of tests Total time Ave TAT"
.W !," ---------------------- ---------- -------"
.W !,?12,+^TMP("LR",$J,LRPTYPE),?35,+$P(^TMP("LR",$J,LRPTYPE),U,2)," min" I +^TMP("LR",$J,LRPTYPE) W ?57,+$P(^TMP("LR",$J,LRPTYPE),U,2)\+^TMP("LR",$J,LRPTYPE)," min"
W "Urgencies:" S LRX=0 F S LRX=$O(LRPQ("URGENCY",LRX)) Q:LRX<1 W !?5,LRPQ("URGENCY",LRX)
W !!,"Tests:" S LRX=0 F S LRX=$O(^TMP("LRTT5",$J,"TESTS",LRX)) Q:LRX<1 W !?5,^(LRX)
I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
CHK I 'LRPDET D CLEANUP Q
SHEAD ;S LRPDHEAD="Test Number of Tests Total TAT Ave TAT",LRPPAGE=0 D DHDR^LRTT5
;F LRPTYPE="REGT","IRREGT" Q:$G(LREND) D
;. D LNCHECK^LRTT5 Q:$G(LREND) W !,$S(LRPTYPE="REGT":"Regular",1:"Irregular")," hours" S LRTEST="" F S LRTEST=$O(^TMP("LR",$J,LRPTYPE,LRTEST)) Q:LRTEST=""!($G(LREND)) S LRX=^(LRTEST) D
;. . D LNCHECK^LRTT5 Q:$G(LREND) W !,LRTEST,?25,$J(+LRX,9,0),?37,$J(+$P(LRX,U,2),9,0) I +LRX W ?50,$J($P(LRX,U,2)/+LRX,9,1)
;I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
S LRPDHEAD="TAT Acc Test In Out" D DHDR^LRTT5 Q:$G(LREND)
TYPE F LRPDTYPE="BAD","REG","IRREG" Q:$G(LREND) D
.D LNCHECK^LRTT5 Q:$G(LREND) W !!,$S(LRPDTYPE="BAD":"Tests not counted:",LRPDTYPE="REG":"Regular hours:",1:"Irregular hours:"),!
.S LRPCNT=0,LRPDIFF="" F S LRPDIFF=$O(^TMP("LR",$J,LRPDTYPE,LRPDIFF)) Q:LRPDIFF="" D
. . S LRPN="" F S LRPN=$O(^TMP("LR",$J,LRPDTYPE,LRPDIFF,LRPN)) Q:LRPN="" S LRPLINE=^(LRPN),LRPCNT=LRPCNT+1 D
. . . D LNCHECK^LRTT5 Q:$G(LREND)
. . . W ! W:$L($P(LRPLINE,U,4)) LRPDIFF W ?6,$P(LRPLINE,U),?21,$E($P(LRPLINE,U,2),1,15),?37,$$FMTE^XLFDT($E($P(LRPLINE,U,3),1,12)) I $L($P(LRPLINE,U,4)) W ?58,$$FMTE^XLFDT($E($P(LRPLINE,U,4),1,12))
.I 'LRPCNT W !,"none found",!
I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
D CLEANUP
Q
CLEANUP ;
STOP K ^TMP("LR",$J),LRPCNT,LRPDET,LRPDHEAD,LRPDIFF,LRPDTYPE,LRPLINE,LRPN,LRPPAGE,LRPQ,LRTEST,LRPTYPE,LRX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRTT5R1 2595 printed Dec 13, 2024@02:21:12 Page 2
LRTT5R1 ;DALISC/FHS - LAB URGENCY TURNAROUND TIMES REPORT GENERATOR ; 12/3/1997
+1 ;;5.2;LAB SERVICE;**153,201,274**;Sep 27, 1994
ONE ; from LRTT5
+1 ; input LRPQ(, ^TMP("LR",$J processed from LRTT5P1
+2 SET LREND=0
+3 IF $ORDER(LRLLOC(0))
WRITE !?10," Institution included in report:"
Begin DoDot:1
+4 SET I=0
FOR
SET I=$ORDER(LRLLOC(I))
if I<1
QUIT
WRITE !?20,$PIECE(LRLLOC(I),U,2)
End DoDot:1
+5 FOR LRPTYPE="REG","IRREG"
Begin DoDot:1
+6 WRITE !," Turnaround Time (TAT) - ",$SELECT(LRPTYPE="REG":"Regular (0701-1700) ",1:"Irregular")," hours",!
+7 WRITE !," Number of tests Total time Ave TAT"
+8 WRITE !," ---------------------- ---------- -------"
+9 WRITE !,?12,+^TMP("LR",$JOB,LRPTYPE),?35,+$PIECE(^TMP("LR",$JOB,LRPTYPE),U,2)," min"
IF +^TMP("LR",$JOB,LRPTYPE)
WRITE ?57,+$PIECE(^TMP("LR",$JOB,LRPTYPE),U,2)\+^TMP("LR",$JOB,LRPTYPE)," min"
End DoDot:1
WRITE !
+10 WRITE "Urgencies:"
SET LRX=0
FOR
SET LRX=$ORDER(LRPQ("URGENCY",LRX))
if LRX<1
QUIT
WRITE !?5,LRPQ("URGENCY",LRX)
+11 WRITE !!,"Tests:"
SET LRX=0
FOR
SET LRX=$ORDER(^TMP("LRTT5",$JOB,"TESTS",LRX))
if LRX<1
QUIT
WRITE !?5,^(LRX)
+12 IF $EXTRACT(IOST,1,2)="C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
if $GET(DIRUT)
SET LREND=1
if LREND
QUIT
CHK IF 'LRPDET
DO CLEANUP
QUIT
SHEAD ;S LRPDHEAD="Test Number of Tests Total TAT Ave TAT",LRPPAGE=0 D DHDR^LRTT5
+1 ;F LRPTYPE="REGT","IRREGT" Q:$G(LREND) D
+2 ;. D LNCHECK^LRTT5 Q:$G(LREND) W !,$S(LRPTYPE="REGT":"Regular",1:"Irregular")," hours" S LRTEST="" F S LRTEST=$O(^TMP("LR",$J,LRPTYPE,LRTEST)) Q:LRTEST=""!($G(LREND)) S LRX=^(LRTEST) D
+3 ;. . D LNCHECK^LRTT5 Q:$G(LREND) W !,LRTEST,?25,$J(+LRX,9,0),?37,$J(+$P(LRX,U,2),9,0) I +LRX W ?50,$J($P(LRX,U,2)/+LRX,9,1)
+4 ;I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S:$G(DIRUT) LREND=1 Q:LREND
+5 SET LRPDHEAD="TAT Acc Test In Out"
DO DHDR^LRTT5
if $GET(LREND)
QUIT
TYPE FOR LRPDTYPE="BAD","REG","IRREG"
if $GET(LREND)
QUIT
Begin DoDot:1
+1 DO LNCHECK^LRTT5
if $GET(LREND)
QUIT
WRITE !!,$SELECT(LRPDTYPE="BAD":"Tests not counted:",LRPDTYPE="REG":"Regular hours:",1:"Irregular hours:"),!
+2 SET LRPCNT=0
SET LRPDIFF=""
FOR
SET LRPDIFF=$ORDER(^TMP("LR",$JOB,LRPDTYPE,LRPDIFF))
if LRPDIFF=""
QUIT
Begin DoDot:2
+3 SET LRPN=""
FOR
SET LRPN=$ORDER(^TMP("LR",$JOB,LRPDTYPE,LRPDIFF,LRPN))
if LRPN=""
QUIT
SET LRPLINE=^(LRPN)
SET LRPCNT=LRPCNT+1
Begin DoDot:3
+4 DO LNCHECK^LRTT5
if $GET(LREND)
QUIT
+5 WRITE !
if $LENGTH($PIECE(LRPLINE,U,4))
WRITE LRPDIFF
WRITE ?6,$PIECE(LRPLINE,U),?21,$EXTRACT($PIECE(LRPLINE,U,2),1,15),?37,$$FMTE^XLFDT($EXTRACT($PIECE(LRPLINE,U,3),1,12))
IF $LENGTH($PIECE(LRPLINE,U,4))
WRITE ?58,$$FMTE^XLFDT($EXTRACT($PIECE(LRPLINE,U,4),1,12))
End DoDot:3
End DoDot:2
+6 IF 'LRPCNT
WRITE !,"none found",!
End DoDot:1
+7 IF $EXTRACT(IOST,1,2)="C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
if $GET(DIRUT)
SET LREND=1
if LREND
QUIT
+8 DO CLEANUP
+9 QUIT
CLEANUP ;
STOP KILL ^TMP("LR",$JOB),LRPCNT,LRPDET,LRPDHEAD,LRPDIFF,LRPDTYPE,LRPLINE,LRPN,LRPPAGE,LRPQ,LRTEST,LRPTYPE,LRX
+1 QUIT
