LRHYT2.m

LRHYT2 ;VA/DALOI/HOAK - RCEV CHECK FOR ALL SCANNED ; 13-Aug-2013 09:16 ; MKK

 ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997

 ;

BUILD ;

 K ^TMP("LRHY3TST",$J)

 ; build a tmp global for all tests on order

 W !,"All tests on this order:"

 N LR3DT,LR3SN,LR3TST,LRIEN

 S LR3DT=0

 F  S LR3DT=$O(^LRO(69,"C",LRCE,LR3DT)) Q:+LR3DT'>0  D

 .  S LR3SN=0

 .  F  S LR3SN=$O(^LRO(69,"C",LRCE,LR3DT,LR3SN)) Q:+LR3SN'>0  D

 ..  S LR3TST=0 S LRIEN=0

 ..  S LR3NX0=$G(^LRO(69,LR3DT,1,LR3SN,0))

 ..  F  S LR3TST=$O(^LRO(69,LR3DT,1,LR3SN,2,"B",LR3TST)) Q:+LR3TST'>0  D

 ...  S LRIEN=0 S LRIEN=$O(^LRO(69,LR3DT,1,LR3SN,2,"B",LR3TST,0))

 ...  K LRNPEED

 ...  I $D(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,1.1)) D

 ....  S LRNPEED=$G(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,1.1,1,0))

 ...  S ^TMP("LRHY3TST",$J,LRCE,LR3TST)=""

 ...  ;

 ...  S LRACC6="" N LRAD,LRAN,LRAA,LRN  D ACCN

 ...  S LRURGNCY=+$P(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,0),U,2)

 ...  I LRURGNCY S LRURGNCY=$P(^LAB(62.05,LRURGNCY,0),U)

 ...  W !,$E($G(LRACC6),1,14),?15,$P($G(^LAB(60,LR3TST,0)),U)

 ...  W ?40,$G(LRURGNCY)

 ...  I $G(LRNPEED)'="" W !,?20,$G(LRNPEED)

 W ! F LRHYI=1:1:79 W "-"

 W !

 ;

 QUIT

REMOVE ;

 ;

 ;

 QUIT

ACCN ;

 S LRN=$G(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,0))

 Q:'LRN

 S LRAD=$P(LRN,U,3)

 I 'LRAD S LRACC="--" QUIT

 S LRAA=$P(LRN,U,4) S LRAN=$P(LRN,U,5)

 S LRACC6=$E($P(^LRO(68,LRAA,0),U,11),1,2)_" "_$E(LRAD,4,7)_" "_LRAN

 QUIT

LRHYT2    ;VA/DALOI/HOAK - RCEV CHECK FOR ALL SCANNED ; 13-Aug-2013 09:16 ; MKK

 +1       ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997

 +2       ;

BUILD     ;

 +1        KILL ^TMP("LRHY3TST",$JOB)

 +2       ; build a tmp global for all tests on order

 +3        WRITE !,"All tests on this order:"

 +4        NEW LR3DT,LR3SN,LR3TST,LRIEN

 +5        SET LR3DT=0

 +6        FOR 

               SET LR3DT=$ORDER(^LRO(69,"C",LRCE,LR3DT))

               IF +LR3DT'>0

                   QUIT 

               Begin DoDot:1

 +7                SET LR3SN=0

 +8                FOR 

                       SET LR3SN=$ORDER(^LRO(69,"C",LRCE,LR3DT,LR3SN))

                       IF +LR3SN'>0

                           QUIT 

                       Begin DoDot:2

 +9                        SET LR3TST=0

                           SET LRIEN=0

 +10                       SET LR3NX0=$GET(^LRO(69,LR3DT,1,LR3SN,0))

 +11                       FOR 

                               SET LR3TST=$ORDER(^LRO(69,LR3DT,1,LR3SN,2,"B",LR3TST))

                               IF +LR3TST'>0

                                   QUIT 

                               Begin DoDot:3

 +12                               SET LRIEN=0

                                   SET LRIEN=$ORDER(^LRO(69,LR3DT,1,LR3SN,2,"B",LR3TST,0))

 +13                               KILL LRNPEED

 +14                               IF $DATA(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,1.1))

                                       Begin DoDot:4

 +15                                       SET LRNPEED=$GET(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,1.1,1,0))

                                       End DoDot:4

 +16                               SET ^TMP("LRHY3TST",$JOB,LRCE,LR3TST)=""

 +17      ;

 +18                               SET LRACC6=""

                                   NEW LRAD,LRAN,LRAA,LRN

                                   DO ACCN

 +19                               SET LRURGNCY=+$PIECE(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,0),U,2)

 +20                               IF LRURGNCY

                                       SET LRURGNCY=$PIECE(^LAB(62.05,LRURGNCY,0),U)

 +21                               WRITE !,$EXTRACT($GET(LRACC6),1,14),?15,$PIECE($GET(^LAB(60,LR3TST,0)),U)

 +22                               WRITE ?40,$GET(LRURGNCY)

 +23                               IF $GET(LRNPEED)'=""

                                       WRITE !,?20,$GET(LRNPEED)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24       WRITE !

           FOR LRHYI=1:1:79

               WRITE "-"

 +25       WRITE !

 +26      ;

 +27       QUIT 

REMOVE    ;

 +1       ;

 +2       ;

 +3        QUIT 

ACCN      ;

 +1        SET LRN=$GET(^LRO(69,LR3DT,1,LR3SN,2,LRIEN,0))

 +2        IF 'LRN

               QUIT 

 +3        SET LRAD=$PIECE(LRN,U,3)

 +4        IF 'LRAD

               SET LRACC="--"

               QUIT 

 +5        SET LRAA=$PIECE(LRN,U,4)

           SET LRAN=$PIECE(LRN,U,5)

 +6        SET LRACC6=$EXTRACT($PIECE(^LRO(68,LRAA,0),U,11),1,2)_" "_$EXTRACT(LRAD,4,7)_" "_LRAN

 +7        QUIT