LRHYF2.m

LRHYF2 ;DALOI/HOAK - LAB ARRIVAL AND DRAW TIME UPDATER ;12/10/10 6:00pm

 ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93

 ;

PAT ;

 ;

 K LRHNV

 S LREND=0

 S DIC="^DPT("

 S DIC(0)="AEMQZ"

 D ^DIC

 S DFN=+Y

 S LRDFN=$G(^DPT(DFN,"LR"))

 D ^VADPT,INP^VADPT

 ;

 QUIT

 ;

SINGLE ;

 ; This block calls up the testing demogs

 ;

 K LRAA,LRAN,LRTEXH,LRPHLEB,LRAD,LRN0,LRHNODE,LR0NODE,LRACC

 W !!

 S LRACC=""

 K LRHN0 D ^LRHYU4

 I LRAN<1 QUIT

JOEIN ;

 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"Doesn't exist." G SINGLE

 S LRUNC=1

 S LRDAT=+$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4),LRSN=+$P(^(0),U,5)

 D LST1^LRHYLS1 ;URG^LRX,TESTS

 S LRTEST=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))

 S LRURG=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0)),U,2)

 W !,$S($D(^LAB(62.05,+LRURG,0)):$P(^(0),U),1:"")," "

 D EDIT

 I $G(LREND) W !,"Please start over..." K LREND,LRIDTNEW

 G SINGLE

 ;

 ;

 QUIT

 ;

 ;

EDIT ;

 D D1^LRHYBC1 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRHYF2   936     printed  Apr 09, 2024@21:22:31                                                                                                                                                                                                       Page 2

LRHYF2    ;DALOI/HOAK - LAB ARRIVAL AND DRAW TIME UPDATER ;12/10/10 6:00pm

 +1       ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93

 +2       ;

PAT       ;

 +1       ;

 +2        KILL LRHNV

 +3        SET LREND=0

 +4        SET DIC="^DPT("

 +5        SET DIC(0)="AEMQZ"

 +6        DO ^DIC

 +7        SET DFN=+Y

 +8        SET LRDFN=$GET(^DPT(DFN,"LR"))

 +9        DO ^VADPT

           DO INP^VADPT

 +10      ;

 +11       QUIT 

 +12      ;

SINGLE    ;

 +1       ; This block calls up the testing demogs

 +2       ;

 +3        KILL LRAA,LRAN,LRTEXH,LRPHLEB,LRAD,LRN0,LRHNODE,LR0NODE,LRACC

 +4        WRITE !!

 +5        SET LRACC=""

 +6        KILL LRHN0

           DO ^LRHYU4

 +7        IF LRAN<1

               QUIT 

JOEIN     ;

 +1        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))

               WRITE !,"Doesn't exist."

               GOTO SINGLE

 +2        SET LRUNC=1

 +3        SET LRDAT=+$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)

           SET LRSN=+$PIECE(^(0),U,5)

 +4       ;URG^LRX,TESTS

           DO LST1^LRHYLS1

 +5        SET LRTEST=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))

 +6        SET LRURG=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0)),U,2)

 +7        WRITE !,$SELECT($DATA(^LAB(62.05,+LRURG,0)):$PIECE(^(0),U),1:"")," "

 +8        DO EDIT

 +9        IF $GET(LREND)

               WRITE !,"Please start over..."

               KILL LREND,LRIDTNEW

 +10       GOTO SINGLE

 +11      ;

 +12      ;

 +13       QUIT 

 +14      ;

 +15      ;

EDIT      ;

 +1        DO D1^LRHYBC1

           QUIT