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 ---[H[J[2J[HLRHYF2 936 printed Nov 22, 2024@17:25:24 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
