| 1 | LROW ;SLC/CJS/JAH - LAB ORDER ENTRY, WARD ;8/10/04
|
|---|
| 2 | ;;5.2;LAB SERVICE;**100,121,291**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | W10 ;
|
|---|
| 5 | K LRBEOT,LRBEQT,LRBEVT,LRBETS,LRBEX,LRBEY,LRBEZ,LRBETYP,LRBEODT,LRBERF
|
|---|
| 6 | D ^LRPARAM K X3,LRNATURE S U="^" D DT^LRX I $D(LRADDTST) Q:LRADDTST=""
|
|---|
| 7 | D NOW^%DTC S LRCDT=% I $G(DFN) D EN2^LRDPA(DFN,0,0)
|
|---|
| 8 | K LRSN,LRCOM,DTOUT,LRTCOM W !! S (LRSN,LRMOR,LRNN)=0 I $D(LRADDTST),$P(LRADDTST,U,2)'="OUT" G MORE
|
|---|
| 9 | K DIC,DFN,LRXST,X3 S DIC(0)="EMQZ",PNM="" D ^LRDPA G LREND^LROW4:(LRDFN=-1)!$D(DUOUT)!$D(DTOUT)
|
|---|
| 10 | D EN2^LRDPA(DFN,1,1) I 'Y G W10
|
|---|
| 11 | S LRDPF=$P(^LR(LRDFN,0),U,2)
|
|---|
| 12 | Q12 D LOC^LRWU G W10:LREND
|
|---|
| 13 | D L5 G LREND^LROW4:LREND
|
|---|
| 14 | G PRAC
|
|---|
| 15 | Q12A S S=$S($D(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0) S I=0 F S I=$O(^LRO(69,LRODT,1,DA,2,I)) Q:I<1 S T(+^(I,0),DA)=S,X=+^(0) S:'$D(TT(X,S)) TT(X,S)=0 S TT(X,S)=TT(X,S)+1
|
|---|
| 16 | Q
|
|---|
| 17 | PRAC D PRAC^LRWU1 I LREND W !!,$C(7),"ORDER CANCELED",!! G W10
|
|---|
| 18 | F I=0:0 K LROUTINE,DIC,LRY,LRURG W !,"Will the urgency for all tests ordered for this patient at this time be",!,$P(^LAB(62.05,+$P(^LAB(69.9,1,3),U,2),0),U) S %=1 D YN^DICN Q:% W " Answer 'Y'es or 'N'o."
|
|---|
| 19 | I %<0 S LREND=1 W !!,$C(7),"ORDER CANCELED",!! G W10
|
|---|
| 20 | I %'=2 S LROUTINE=$P(^LAB(69.9,1,3),U,2)
|
|---|
| 21 | MORE ;from LROR
|
|---|
| 22 | K T,TT,LRCOM,LRTCOM,LROT,LRTMAX,LRDTST,LRDMAX,LRBEX
|
|---|
| 23 | S DA=0 F S DA=$O(^LRO(69,LRODT,1,"AA",LRDFN,DA)) Q:DA<1 I $S($D(^LRO(69,LRODT,1,DA,1)):$P(^(1),U,4)'="U",1:1) S LRSAMP=$P(^(0),U,3) D Q12A
|
|---|
| 24 | S LRCCOM="" D ^LROW1
|
|---|
| 25 | S LRBEY=1 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D G LEND:'LRBEY
|
|---|
| 26 | .D BALROW^LRBEBA3(LRODT,LRSN,.LRTEST)
|
|---|
| 27 | Q:$D(DIROUT) I $D(LRADDTST),$P(LRADDTST,U,2)="OUT" G NOMORE
|
|---|
| 28 | G W10:LRTSTN=0
|
|---|
| 29 | NOMORE ;from LROR
|
|---|
| 30 | S LRSNO=LRDFN_"^"_DUZ_"^^"_LRLWC_"^"_LRCDT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRODT_$S(+LRORDTIM:"."_LRORDTIM,1:"")
|
|---|
| 31 | D ^LROW3 I %["N"!$D(DTOUT)!(%["^")!'$D(LRXST) D W20 G LREND^LROW4:$D(LRADDTST),W10
|
|---|
| 32 | D LROW^LRORDD
|
|---|
| 33 | D REST^LROW2 K LRBEX,LRORIFN Q:$D(LRADDTST)
|
|---|
| 34 | S DIR(0)="Y",DIR("A")="Do you want to place another order for this patient",DIR("B")="NO" D ^DIR K DIR
|
|---|
| 35 | G W10:Y'=1
|
|---|
| 36 | K X3,LRY,LRURG,LROUTINE D @$S(LRLWC="I":"^LRORDIM",1:"NEXTCOL^LROW5") G W10:LREND,MORE
|
|---|
| 37 | W20 ;from LROE1
|
|---|
| 38 | K LRSNO,LRLLOC,LROLLOC,LRTREA,LRCDT,LRSN,LRSTATUS W:$D(LRXST) !!,$C(7),$S($D(LRADDTST):"ADDITIONAL ",1:""),"ORDER DELETED",! K LRXST Q
|
|---|
| 39 | L5 ;from LROR, LROR4
|
|---|
| 40 | ;S LREND=0 W !," (S)END patient to lab",!," (W)ARD collect & deliver",!," (B)LOOD orders for lab draw",!," (I)MMED Lab Collect ",!
|
|---|
| 41 | L5A ;R !,"Select: ",X:DTIME G LEND:X["^"!'$T,L5:X="" S X=$E(X,1)
|
|---|
| 42 | ;I "SBWI"'[X W !,"Enter 'S' for SEND TO LAB",!?6,"'W' for WARD COLLECT",!?6,"'B' for BLOOD COLLECTED BY LAB.",!?6,"'I' for Immediate Lab Collect",!?6,"'^' to Exit." G L5A
|
|---|
| 43 | ;S LRLWC=$S(X["W":"WC",X["S":"SP",X["I":"I",1:"LC")
|
|---|
| 44 | L5B ;
|
|---|
| 45 | D COLTY^LRWU Q:LREND
|
|---|
| 46 | I LRLWC="I" D ^LRORDIM S:'$D(LRCDT) LREND=1 Q:LREND S ^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)="" Q
|
|---|
| 47 | D NEXTCOL^LROW5 Q:LREND S ^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)="" Q
|
|---|
| 48 | LEND ;from LROW5
|
|---|
| 49 | S LREND=1 Q
|
|---|
| 50 | TIME ;from LROW5
|
|---|
| 51 | S Z=$S(+$E(Y,1,2)>11:"PM",1:"AM"),Y=$E(Y_0,1,2)-$S($E(Y_0,1,2)=12:0,Z="PM":12,1:0)_":"_$E(Y_"000",3,4)_Z
|
|---|
| 52 | W Y
|
|---|
| 53 | Q
|
|---|
| 54 | ADD ;from LRAD2ORD
|
|---|
| 55 | Q:LRADDTST="" D DT^LRX D W10
|
|---|
| 56 | Q
|
|---|
