- 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 Feb 18, 2025@23:43:25 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
