LRMITSP ;SLC/STAFF - MICRO TREND PROCESS ;3/4/93 16:59
;;5.2;LAB SERVICE;**96**;Sep 27, 1994
; LRATS inverse start time
; LRFBEG formatted begin time
; LRFEND formatted end time
; LRTSAL inverse end time
;
DQ ; dequeued from LRMITS
; initialize variables
S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J)
S LRFBEG=$$FMTE^XLFDT(LRTBEG),LRFEND=$$FMTE^XLFDT(LRTEND),LRTEND=$S($E(LRTEND,6,7)="00":LRTEND+99,1:LRTEND+.24) ;,LRTEND=$E(LRTEND,1,5)_99
S LRATS=9999999-LRTBEG,LRTSAL=9999999-LRTEND
D ^LRMITSRS
S LRDN=0 F S LRDN=$O(^LAB(62.06,"AD",LRDN)) Q:LRDN<2 S LRANTIN=$O(^(LRDN,0)) I LRANTIN D
.S LRX=$G(^LAB(62.06,LRANTIN,0)),LRANTINM=$P(LRX,U,5) Q:'$L(LRANTINM)
.S LRANTIF=$S($P(LRX,U,4):+$P(LRX,U,4),1:"") I LRANTIF S LRANTIF=$$VALUE^LRMITSPE(LRANTIF,62.06,5) I $L(LRANTIF) S LRANTIF=$E(LRANTIF)_$$LOW^XLFSTR($E(LRANTIF,2,99))
.S ^TMP($J,"A",LRDN)=LRANTIN_U_LRANTINM,^TMP($J,"AB",LRANTINM)=LRDN_U_LRANTIF
.S:LRSORT ^TMP($J,"PSRT",$P(LRX,U,7))=LRANTINM
S LRDN=2 F S LRDN=$O(^DD(63.39,"GL",LRDN)) Q:LRDN<2 S LRANTIN=$O(^(LRDN,1,0)) I LRANTIN D
.S LRX=$G(^DD(63.39,LRANTIN,0)),LRANTINM=$P(LRX,U) Q:'$L(LRANTINM)
.S ^TMP($J,"T",LRDN)=LRANTINM
K LRANTIF,LRANTIN,LRANTINM,LRDN,LRTBEG,LRTEND,LRX
; extract data
D ^LRMITSPE I LREND Q
; count and merge data
D ^LRMITSPC I LREND Q
; report data
D ^LRMITSR
D CLEANUP^LRMITS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMITSP 1367 printed Oct 16, 2024@18:18:17 Page 2
LRMITSP ;SLC/STAFF - MICRO TREND PROCESS ;3/4/93 16:59
+1 ;;5.2;LAB SERVICE;**96**;Sep 27, 1994
+2 ; LRATS inverse start time
+3 ; LRFBEG formatted begin time
+4 ; LRFEND formatted end time
+5 ; LRTSAL inverse end time
+6 ;
DQ ; dequeued from LRMITS
+1 ; initialize variables
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB)
+3 ;,LRTEND=$E(LRTEND,1,5)_99
SET LRFBEG=$$FMTE^XLFDT(LRTBEG)
SET LRFEND=$$FMTE^XLFDT(LRTEND)
SET LRTEND=$SELECT($EXTRACT(LRTEND,6,7)="00":LRTEND+99,1:LRTEND+.24)
+4 SET LRATS=9999999-LRTBEG
SET LRTSAL=9999999-LRTEND
+5 DO ^LRMITSRS
+6 SET LRDN=0
FOR
SET LRDN=$ORDER(^LAB(62.06,"AD",LRDN))
if LRDN<2
QUIT
SET LRANTIN=$ORDER(^(LRDN,0))
IF LRANTIN
Begin DoDot:1
+7 SET LRX=$GET(^LAB(62.06,LRANTIN,0))
SET LRANTINM=$PIECE(LRX,U,5)
if '$LENGTH(LRANTINM)
QUIT
+8 SET LRANTIF=$SELECT($PIECE(LRX,U,4):+$PIECE(LRX,U,4),1:"")
IF LRANTIF
SET LRANTIF=$$VALUE^LRMITSPE(LRANTIF,62.06,5)
IF $LENGTH(LRANTIF)
SET LRANTIF=$EXTRACT(LRANTIF)_$$LOW^XLFSTR($EXTRACT(LRANTIF,2,99))
+9 SET ^TMP($JOB,"A",LRDN)=LRANTIN_U_LRANTINM
SET ^TMP($JOB,"AB",LRANTINM)=LRDN_U_LRANTIF
+10 if LRSORT
SET ^TMP($JOB,"PSRT",$PIECE(LRX,U,7))=LRANTINM
End DoDot:1
+11 SET LRDN=2
FOR
SET LRDN=$ORDER(^DD(63.39,"GL",LRDN))
if LRDN<2
QUIT
SET LRANTIN=$ORDER(^(LRDN,1,0))
IF LRANTIN
Begin DoDot:1
+12 SET LRX=$GET(^DD(63.39,LRANTIN,0))
SET LRANTINM=$PIECE(LRX,U)
if '$LENGTH(LRANTINM)
QUIT
+13 SET ^TMP($JOB,"T",LRDN)=LRANTINM
End DoDot:1
+14 KILL LRANTIF,LRANTIN,LRANTINM,LRDN,LRTBEG,LRTEND,LRX
+15 ; extract data
+16 DO ^LRMITSPE
IF LREND
QUIT
+17 ; count and merge data
+18 DO ^LRMITSPC
IF LREND
QUIT
+19 ; report data
+20 DO ^LRMITSR
+21 DO CLEANUP^LRMITS
+22 QUIT
