LRMITSP.m

LRMITSP ; IHS/DIR/FJE - MICRO TREND PROCESS 16:59 ; 

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;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

LRMITSP   ; IHS/DIR/FJE - MICRO TREND PROCESS 16:59 ; 

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;**96**;Sep 27, 1994

 +4       ; LRATS  inverse start time

 +5       ; LRFBEG  formatted begin time

 +6       ; LRFEND  formatted end time

 +7       ; LRTSAL  inverse end time

 +8       ;

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