| 1 | LROE1 ;SLC/CJS - MORE ORDER ENTRY ;8/11/97
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**100,121**;Sep 27, 1994
 | 
|---|
| 3 | QUICK ;from LROE
 | 
|---|
| 4 |  S DA=LRODT K DFN,LRURG,LRSN,DIC,X3 S DIC(0)="EMQ"_$S($P(LRPARAM,U,6):"L",1:"") S:$D(LRNCWL) DIC=0 D ^LRDPA G END^LROE:(LRDFN=-1)!$D(DUOUT)!$D(DTOUT) S LRSN=0,LRMOR=0,LRNN=0 D PT^LRX
 | 
|---|
| 5 | Q12 D LOC^LRWU G QUICK:LREND
 | 
|---|
| 6 | W13 I '$D(LRQUICK) S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) I LRSN W:'LRMOR !,"ORDERED:" S LRMOR=1 W:$D(^LRO(69,LRODT,1,LRSN,.1)) !!,"ORDER #: ",+^(.1) D SHORT G W13
 | 
|---|
| 7 |  G Q10:$D(LRQUICK)!'LRMOR
 | 
|---|
| 8 |  F I=0:0 W !,"Do you want an expanded list" S %=2 D YN^DICN Q:%  W " Answer 'Y'es or 'N'o."
 | 
|---|
| 9 |  G QUICK:%=-1,W16:%'=1
 | 
|---|
| 10 |  S DIC="^LRO(69,"_LRODT_",1,",DR="0:3",DA=0
 | 
|---|
| 11 |  W !,"Order #",!,"  Test",?20,"Urgency",?30,"Status",?64,"Accession"
 | 
|---|
| 12 |  S LRSVSN=LRSN,LRSN=0 S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1  D ORDER^LROS
 | 
|---|
| 13 |  S LRSN=LRSVSN
 | 
|---|
| 14 | W16 I $D(LRLONG) K LRDFN G NEXT^LROE
 | 
|---|
| 15 |  W !,"Is the test one of the above" S %=2 D YN^DICN IF %'=2 K LRDFN G NEXT^LROE
 | 
|---|
| 16 | Q10 D PRAC^LRWU1 G LREND:LREND
 | 
|---|
| 17 |  S LRCCOM="" D ^LROW1 G NEXT^LROE:LRTSTN=0
 | 
|---|
| 18 | W12 D NOW^%DTC S D1=% D COLTY^LRWU G:LREND LREND
 | 
|---|
| 19 |  S LRSNO=LRDFN_"^"_DUZ_"^^"_LRLWC_"^"_D1_"^"_LRPRAC_"^"_LRLLOC
 | 
|---|
| 20 |  W !!,PNM,?30,SSN
 | 
|---|
| 21 |  D ^LROW3 I %["N"!(%["^")!($D(LRTEST)=1) D W20^LROW G NEXT^LROE
 | 
|---|
| 22 |  D REST^LROW2 S LRSN=$O(LRSN(0)) G LREND:LRSN="" S LRSTATUS="C" D P15 G LREND:LRCDT<1
 | 
|---|
| 23 |  S LRI=LRSN F  S LRSN=$O(LRSN(LRSN)) Q:'LRSN  D P15
 | 
|---|
| 24 |  S LRSN=LRI,I=0 F J=1:1 S I=$O(LRSN(I)) Q:'I  S ^LRO(69,LRODT,1,I,1)=.00001*J+^LRO(69,LRODT,1,LRSN,1)_U_$P(^LRO(69,LRODT,1,I,1),U,2,99)
 | 
|---|
| 25 |  D Q15^LROE2,TASK^LROE G NEXT^LROE
 | 
|---|
| 26 | Q15 ;from LROE
 | 
|---|
| 27 |  D Q15^LROE2
 | 
|---|
| 28 |  Q
 | 
|---|
| 29 | P15 ;from LRVER,LRVR,LRGV
 | 
|---|
| 30 |  N COMB
 | 
|---|
| 31 |  S E=0 F  S E=$O(^LRO(69,LRODT,1,LRSN,2,E)) Q:'E  W !,$P(^LAB(60,+^(E,0),0),"^")
 | 
|---|
| 32 |  D TIME^LROE Q:LRCDT<1  S LRUN=$P(LRCDT,"^",2),LRTIM=+LRCDT,LRNT=LRTIM S $P(^LRO(69,LRODT,1,LRSN,0),U,8)=LRTIM
 | 
|---|
| 33 |  I '$D(LRCDT) S (LRCDT,LRTIM,LRNT)=$P(^LRO(69,LRODT,1,LRSN,0),U,8),LRUN=""
 | 
|---|
| 34 |  I $P(^(0),U,4)="LC",$D(^(1)) S LRLLOC=$P(^(0),U,7),LROLLOC=$P(^(0),U,9),LRNT=$S($D(LRNT):LRNT,$D(LRTIM):LRTIM,$D(LRCDT):+LRCDT,1:"") D P15^LRPHITEM Q
 | 
|---|
| 35 |  S COMB=$P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7)
 | 
|---|
| 36 |  S ^LRO(69,LRODT,1,LRSN,1)=LRTIM_"^"_LRUN_"^"_DUZ_"^"_LRSTATUS_"^^^"_COMB_"^"_DUZ(2) S:LRSTATUS="C" ^LRO(69,"AA",+$G(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)="" Q
 | 
|---|
| 37 | SHORT ;Short list of tests
 | 
|---|
| 38 |  N X,I
 | 
|---|
| 39 |  S I=0 F  S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1  S X=^(I,0) I X W !,$P(^LAB(60,+X,0),U) I $P(X,"^",11) W ?40," Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^")
 | 
|---|
| 40 |  Q
 | 
|---|
| 41 | LRSPEC S LRSAMP=+$P(^LRO(69,LRODT,1,LRSN,0),U,3),LRSPEC=$S($D(^LAB(62,LRSAMP,0)):$P(^(0),U,2),1:"")
 | 
|---|
| 42 |  I 'LRSPEC S I=$O(^LRO(69,LRODT,1,LRSN,4,0)) I I,$D(^(I,0)) S LRSPEC=$P(^(0),U)
 | 
|---|
| 43 | LREND K DIR Q
 | 
|---|