- LRHYT2 ;DALOI/HOAK - RCEV CHECK FOR ALL SCANNED ;9/17/2000
- ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYT2 1393 printed Jan 18, 2025@03:16:10 Page 2
- LRHYT2 ;DALOI/HOAK - RCEV CHECK FOR ALL SCANNED ;9/17/2000
- +1 ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
- +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