- LRULB ; IHS/DIR/FJE - LAB LOG-BOOK 2/18/93 12:48 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- W !!?20,LRAA(1)," Log-Book" S Y=DT D LRAD
- W !!,"Accession list date: ",LRH(0)," OK " S %=1 D YN^LRU G:%<1 END
- ASK I %'=1 W ! S %DT("A")="Select DATE: ",%DT="AQE" D ^%DT K %DT G:Y<1 END D LRAD
- I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"No accession numbers for ",LRH(0) S %=2 G ASK
- N I LRAD'["00" R !,"Start with Acc #: FIRST // ",N(1):DTIME G:'$T!(N(1)["^") END S:N(1)="" N(1)=1 I N(1)'?1N.N W $C(7),!!,"Enter NUMBERS only" G N
- I LRAD["00" R !,"Start with Acc #: ",N(1):DTIME G:N(1)=""!(N(1)["^") END I N(1)'?1N.N W $C(7),!!,"NUMBERS ONLY !!" G N
- M R !,"Go to Acc #: LAST // ",N(2):DTIME G:N(2)='$T!(N(2)["^") END S:N(2)="" N(2)=999999 I N(2)'?1N.N W $C(7),!!,"NUMBERS ONLY !!",!! G M
- I N(2)<N(1) S X=N(1),N(1)=N(2),N(2)=X
- S ZTRTN="QUE^LRULB" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO D L^LRU,S^LRU G ^LRULB1
- ;
- LRAD S X=$P(^LRO(68,LRAA,0),"^",3),(Y,LRAD)=$S(X="Y":$E(Y,1,3)_"0000","M"[X:$E(Y,1,5)_"00","Q"[X:$E(Y,1,3)_"0000"+(($E(Y,4,5)-1)\3*300+100),1:Y) D D^LRU S LRH(0)=Y Q
- ;
- END D V^LRU Q
- LRULB ; IHS/DIR/FJE - LAB LOG-BOOK 2/18/93 12:48 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 WRITE !!?20,LRAA(1)," Log-Book"
- SET Y=DT
- DO LRAD
- +5 WRITE !!,"Accession list date: ",LRH(0)," OK "
- SET %=1
- DO YN^LRU
- IF %<1
- GOTO END
- ASK IF %'=1
- WRITE !
- SET %DT("A")="Select DATE: "
- SET %DT="AQE"
- DO ^%DT
- KILL %DT
- IF Y<1
- GOTO END
- DO LRAD
- +1 IF '$DATA(^LRO(68,LRAA,1,LRAD,0))
- WRITE $CHAR(7),!!,"No accession numbers for ",LRH(0)
- SET %=2
- GOTO ASK
- N IF LRAD'["00"
- READ !,"Start with Acc #: FIRST // ",N(1):DTIME
- IF '$TEST!(N(1)["^")
- GOTO END
- IF N(1)=""
- SET N(1)=1
- IF N(1)'?1N.N
- WRITE $CHAR(7),!!,"Enter NUMBERS only"
- GOTO N
- +1 IF LRAD["00"
- READ !,"Start with Acc #: ",N(1):DTIME
- IF N(1)=""!(N(1)["^")
- GOTO END
- IF N(1)'?1N.N
- WRITE $CHAR(7),!!,"NUMBERS ONLY !!"
- GOTO N
- M READ !,"Go to Acc #: LAST // ",N(2):DTIME
- IF N(2)='$TEST!(N(2)["^")
- GOTO END
- IF N(2)=""
- SET N(2)=999999
- IF N(2)'?1N.N
- WRITE $CHAR(7),!!,"NUMBERS ONLY !!",!!
- GOTO M
- +1 IF N(2)<N(1)
- SET X=N(1)
- SET N(1)=N(2)
- SET N(2)=X
- +2 SET ZTRTN="QUE^LRULB"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- DO L^LRU
- DO S^LRU
- GOTO ^LRULB1
- +1 ;
- LRAD SET X=$PIECE(^LRO(68,LRAA,0),"^",3)
- SET (Y,LRAD)=$SELECT(X="Y":$EXTRACT(Y,1,3)_"0000","M"[X:$EXTRACT(Y,1,5)_"00","Q"[X:$EXTRACT(Y,1,3)_"0000"+(($EXTRACT(Y,4,5)-1)\3*300+100),1:Y)
- DO D^LRU
- SET LRH(0)=Y
- QUIT
- +1 ;
- END DO V^LRU
- QUIT
