- LROW ;SLC/CJS/JAH - LAB ORDER ENTRY, WARD ;8/10/04
- ;;5.2;LAB SERVICE;**1003,1009,1013,1031**;NOV 1, 1997
- ;
- ;;VA LR Patch(s): 100,121,291
- ;
- ;
- W10 ;
- K LRBEOT,LRBEQT,LRBEVT,LRBETS,LRBEX,LRBEY,LRBEZ,LRBETYP,LRBEODT,LRBERF
- D ^LRPARAM K X3,LRNATURE S U="^" D DT^LRX I $D(LRADDTST) Q:LRADDTST=""
- D NOW^%DTC S LRCDT=% I $G(DFN) D EN2^LRDPA(DFN,0,0)
- K LRSN,LRCOM,DTOUT,LRTCOM W !! S (LRSN,LRMOR,LRNN)=0 I $D(LRADDTST),$P(LRADDTST,U,2)'="OUT" G MORE
- K DIC,DFN,LRXST,X3 S DIC(0)="EMQZ",PNM="" D ^LRDPA G LREND^LROW4:(LRDFN=-1)!$D(DUOUT)!$D(DTOUT)
- D EN2^LRDPA(DFN,1,1) I 'Y G W10
- S LRDPF=$P(^LR(LRDFN,0),U,2)
- Q12 D LOC^LRWU G W10:LREND
- D L5 G LREND^LROW4:LREND
- G PRAC
- 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
- Q
- PRAC D PRAC^LRWU1 I LREND W !!,$C(7),"ORDER CANCELED",!! G W10
- 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."
- I %<0 S LREND=1 W !!,$C(7),"ORDER CANCELED",!! G W10
- I %'=2 S LROUTINE=$P(^LAB(69.9,1,3),U,2)
- MORE ;from LROR
- K T,TT,LRCOM,LRTCOM,LROT,LRTMAX,LRDTST,LRDMAX,LRBEX
- 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
- S LRCCOM="" D ^LROW1
- S LRBEY=1 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D G LEND:'LRBEY
- .D BALROW^LRBEBA3(LRODT,LRSN,.LRTEST)
- Q:$D(DIROUT) I $D(LRADDTST),$P(LRADDTST,U,2)="OUT" G NOMORE
- G W10:LRTSTN=0
- NOMORE ;from LROR
- S LRSNO=LRDFN_"^"_DUZ_"^^"_LRLWC_"^"_LRCDT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRODT_$S(+LRORDTIM:"."_LRORDTIM,1:"")
- D ^LROW3 I %["N"!$D(DTOUT)!(%["^")!'$D(LRXST) D W20 G LREND^LROW4:$D(LRADDTST),W10
- D LROW^LRORDD
- ; D REST^LROW2 K LRBEX,LRORIFN Q:$D(LRADDTST)
- D REST^LROW2 K LRORIFN Q:$D(LRADDTST) ;IHS/DIR/MJL 09/20/99
- S DIR(0)="Y",DIR("A")="Do you want to place another order for this patient",DIR("B")="NO" D ^DIR K DIR
- G W10:Y'=1
- K X3,LRY,LRURG,LROUTINE D @$S(LRLWC="I":"^LRORDIM",1:"NEXTCOL^LROW5") G W10:LREND,MORE
- W20 ;from LROE1
- K LRSNO,LRLLOC,LROLLOC,LRTREA,LRCDT,LRSN,LRSTATUS W:$D(LRXST) !!,$C(7),$S($D(LRADDTST):"ADDITIONAL ",1:""),"ORDER DELETED",! K LRXST Q
- L5 ;from LROR, LROR4
- ;S LREND=0 W !," (S)END patient to lab",!," (W)ARD collect & deliver",!," (B)LOOD orders for lab draw",!," (I)MMED Lab Collect ",!
- L5A ;R !,"Select: ",X:DTIME G LEND:X["^"!'$T,L5:X="" S X=$E(X,1)
- ;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
- ;S LRLWC=$S(X["W":"WC",X["S":"SP",X["I":"I",1:"LC")
- L5B ;
- D COLTY^LRWU Q:LREND
- I LRLWC="I" D ^LRORDIM S:'$D(LRCDT) LREND=1 Q:LREND S ^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)="" Q
- D NEXTCOL^LROW5 Q:LREND S ^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)="" Q
- LEND ;from LROW5
- S LREND=1 Q
- TIME ;from LROW5
- 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
- W Y
- Q
- ADD ;from LRAD2ORD
- Q:LRADDTST="" D DT^LRX D W10
- Q
- LROW ;SLC/CJS/JAH - LAB ORDER ENTRY, WARD ;8/10/04
- +1 ;;5.2;LAB SERVICE;**1003,1009,1013,1031**;NOV 1, 1997
- +2 ;
- +3 ;;VA LR Patch(s): 100,121,291
- +4 ;
- +5 ;
- W10 ;
- +1 KILL LRBEOT,LRBEQT,LRBEVT,LRBETS,LRBEX,LRBEY,LRBEZ,LRBETYP,LRBEODT,LRBERF
- +2 DO ^LRPARAM
- KILL X3,LRNATURE
- SET U="^"
- DO DT^LRX
- IF $DATA(LRADDTST)
- IF LRADDTST=""
- QUIT
- +3 DO NOW^%DTC
- SET LRCDT=%
- IF $GET(DFN)
- DO EN2^LRDPA(DFN,0,0)
- +4 KILL LRSN,LRCOM,DTOUT,LRTCOM
- WRITE !!
- SET (LRSN,LRMOR,LRNN)=0
- IF $DATA(LRADDTST)
- IF $PIECE(LRADDTST,U,2)'="OUT"
- GOTO MORE
- +5 KILL DIC,DFN,LRXST,X3
- SET DIC(0)="EMQZ"
- SET PNM=""
- DO ^LRDPA
- IF (LRDFN=-1)!$DATA(DUOUT)!$DATA(DTOUT)
- GOTO LREND^LROW4
- +6 DO EN2^LRDPA(DFN,1,1)
- IF 'Y
- GOTO W10
- +7 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- Q12 DO LOC^LRWU
- IF LREND
- GOTO W10
- +1 DO L5
- IF LREND
- GOTO LREND^LROW4
- +2 GOTO PRAC
- Q12A SET S=$SELECT($DATA(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0)
- SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,DA,2,I))
- IF I<1
- QUIT
- SET T(+^(I,0),DA)=S
- SET X=+^(0)
- IF '$DATA(TT(X,S))
- SET TT(X,S)=0
- SET TT(X,S)=TT(X,S)+1
- +1 QUIT
- PRAC DO PRAC^LRWU1
- IF LREND
- WRITE !!,$CHAR(7),"ORDER CANCELED",!!
- GOTO W10
- +1 FOR I=0:0
- KILL LROUTINE,DIC,LRY,LRURG
- WRITE !,"Will the urgency for all tests ordered for this patient at this time be",!,$PIECE(^LAB(62.05,+$PIECE(^LAB(69.9,1,3),U,2),0),U)
- SET %=1
- DO YN^DICN
- IF %
- QUIT
- WRITE " Answer 'Y'es or 'N'o."
- +2 IF %<0
- SET LREND=1
- WRITE !!,$CHAR(7),"ORDER CANCELED",!!
- GOTO W10
- +3 IF %'=2
- SET LROUTINE=$PIECE(^LAB(69.9,1,3),U,2)
- MORE ;from LROR
- +1 KILL T,TT,LRCOM,LRTCOM,LROT,LRTMAX,LRDTST,LRDMAX,LRBEX
- +2 SET DA=0
- FOR
- SET DA=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,DA))
- IF DA<1
- QUIT
- IF $SELECT($DATA(^LRO(69,LRODT,1,DA,1)):$PIECE(^(1),U,4)'="U",1:1)
- SET LRSAMP=$PIECE(^(0),U,3)
- DO Q12A
- +3 SET LRCCOM=""
- DO ^LROW1
- +4 SET LRBEY=1
- IF +LRDPF=2&($GET(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT))
- Begin DoDot:1
- +5 DO BALROW^LRBEBA3(LRODT,LRSN,.LRTEST)
- End DoDot:1
- IF 'LRBEY
- GOTO LEND
- +6 IF $DATA(DIROUT)
- QUIT
- IF $DATA(LRADDTST)
- IF $PIECE(LRADDTST,U,2)="OUT"
- GOTO NOMORE
- +7 IF LRTSTN=0
- GOTO W10
- NOMORE ;from LROR
- +1 SET LRSNO=LRDFN_"^"_DUZ_"^^"_LRLWC_"^"_LRCDT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRODT_$SELECT(+LRORDTIM:"."_LRORDTIM,1:"")
- +2 DO ^LROW3
- IF %["N"!$DATA(DTOUT)!(%["^")!'$DATA(LRXST)
- DO W20
- IF $DATA(LRADDTST)
- GOTO LREND^LROW4
- GOTO W10
- +3 DO LROW^LRORDD
- +4 ; D REST^LROW2 K LRBEX,LRORIFN Q:$D(LRADDTST)
- +5 ;IHS/DIR/MJL 09/20/99
- DO REST^LROW2
- KILL LRORIFN
- IF $DATA(LRADDTST)
- QUIT
- +6 SET DIR(0)="Y"
- SET DIR("A")="Do you want to place another order for this patient"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +7 IF Y'=1
- GOTO W10
- +8 KILL X3,LRY,LRURG,LROUTINE
- DO @$SELECT(LRLWC="I":"^LRORDIM",1:"NEXTCOL^LROW5")
- IF LREND
- GOTO W10
- GOTO MORE
- W20 ;from LROE1
- +1 KILL LRSNO,LRLLOC,LROLLOC,LRTREA,LRCDT,LRSN,LRSTATUS
- IF $DATA(LRXST)
- WRITE !!,$CHAR(7),$SELECT($DATA(LRADDTST):"ADDITIONAL ",1:""),"ORDER DELETED",!
- KILL LRXST
- QUIT
- L5 ;from LROR, LROR4
- +1 ;S LREND=0 W !," (S)END patient to lab",!," (W)ARD collect & deliver",!," (B)LOOD orders for lab draw",!," (I)MMED Lab Collect ",!
- L5A ;R !,"Select: ",X:DTIME G LEND:X["^"!'$T,L5:X="" S X=$E(X,1)
- +1 ;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
- +2 ;S LRLWC=$S(X["W":"WC",X["S":"SP",X["I":"I",1:"LC")
- L5B ;
- +1 DO COLTY^LRWU
- IF LREND
- QUIT
- +2 IF LRLWC="I"
- DO ^LRORDIM
- IF '$DATA(LRCDT)
- SET LREND=1
- IF LREND
- QUIT
- SET ^LRO(69,LRODT,0)=LRODT
- SET ^LRO(69,"B",LRODT,LRODT)=""
- QUIT
- +3 DO NEXTCOL^LROW5
- IF LREND
- QUIT
- SET ^LRO(69,LRODT,0)=LRODT
- SET ^LRO(69,"B",LRODT,LRODT)=""
- QUIT
- LEND ;from LROW5
- +1 SET LREND=1
- QUIT
- TIME ;from LROW5
- +1 SET Z=$SELECT(+$EXTRACT(Y,1,2)>11:"PM",1:"AM")
- SET Y=$EXTRACT(Y_0,1,2)-$SELECT($EXTRACT(Y_0,1,2)=12:0,Z="PM":12,1:0)_":"_$EXTRACT(Y_"000",3,4)_Z
- +2 WRITE Y
- +3 QUIT
- ADD ;from LRAD2ORD
- +1 IF LRADDTST=""
- QUIT
- DO DT^LRX
- DO W10
- +2 QUIT
