- LROE1 ;SLC/CJS - MORE ORDER ENTRY ;Jun 02, 2022@15:45
- ;;5.2;LAB SERVICE;**100,121,559**;Sep 27, 1994;Build 3
- QUICK ;from LROE
- 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
- Q12 D LOC^LRWU G QUICK:LREND
- 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
- G Q10:$D(LRQUICK)!'LRMOR
- F I=0:0 W !,"Do you want an expanded list" S %=2 D YN^DICN Q:% W " Answer 'Y'es or 'N'o."
- G QUICK:%=-1,W16:%'=1
- S DIC="^LRO(69,"_LRODT_",1,",DR="0:3",DA=0
- W !,"Order #",!," Test",?20,"Urgency",?30,"Status",?64,"Accession"
- S LRSVSN=LRSN,LRSN=0 S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D ORDER^LROS
- S LRSN=LRSVSN
- W16 I $D(LRLONG) K LRDFN G NEXT^LROE
- W !,"Is the test one of the above" S %=2 D YN^DICN IF %'=2 K LRDFN G NEXT^LROE
- Q10 D PRAC^LRWU1 G LREND:LREND
- S LRCCOM="" D ^LROW1 G NEXT^LROE:LRTSTN=0
- W12 D NOW^%DTC S D1=% D COLTY^LRWU G:LREND LREND
- S LRSNO=LRDFN_"^"_DUZ_"^^"_LRLWC_"^"_D1_"^"_LRPRAC_"^"_LRLLOC
- W !!,PNM,?30,SSN
- D ^LROW3 I %["N"!(%["^")!($D(LRTEST)=1) D W20^LROW G NEXT^LROE
- D REST^LROW2 S LRSN=$O(LRSN(0)) G LREND:LRSN="" S LRSTATUS="C" D P15 G LREND:LRCDT<1
- S LRI=LRSN F S LRSN=$O(LRSN(LRSN)) Q:'LRSN D P15
- ;LR*5.2*559: Deleting logic which adds .00001 to collection date/time.
- ; Keeping LRSN in case it is needed downstream.
- ;former line:
- ;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)
- S LRSN=LRI
- D Q15^LROE2,TASK^LROE G NEXT^LROE
- Q15 ;from LROE
- D Q15^LROE2
- Q
- P15 ;from LRVER,LRVR,LRGV
- N COMB
- S E=0 F S E=$O(^LRO(69,LRODT,1,LRSN,2,E)) Q:'E W !,$P(^LAB(60,+^(E,0),0),"^")
- 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
- I '$D(LRCDT) S (LRCDT,LRTIM,LRNT)=$P(^LRO(69,LRODT,1,LRSN,0),U,8),LRUN=""
- 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
- S COMB=$P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7)
- 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
- SHORT ;Short list of tests
- N X,I
- 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),"^")
- Q
- LRSPEC S LRSAMP=+$P(^LRO(69,LRODT,1,LRSN,0),U,3),LRSPEC=$S($D(^LAB(62,LRSAMP,0)):$P(^(0),U,2),1:"")
- I 'LRSPEC S I=$O(^LRO(69,LRODT,1,LRSN,4,0)) I I,$D(^(I,0)) S LRSPEC=$P(^(0),U)
- LREND K DIR Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROE1 2851 printed Feb 18, 2025@23:44:23 Page 2
- LROE1 ;SLC/CJS - MORE ORDER ENTRY ;Jun 02, 2022@15:45
- +1 ;;5.2;LAB SERVICE;**100,121,559**;Sep 27, 1994;Build 3
- QUICK ;from LROE
- +1 SET DA=LRODT
- KILL DFN,LRURG,LRSN,DIC,X3
- SET DIC(0)="EMQ"_$SELECT($PIECE(LRPARAM,U,6):"L",1:"")
- if $DATA(LRNCWL)
- SET DIC=0
- DO ^LRDPA
- if (LRDFN=-1)!$DATA(DUOUT)!$DATA(DTOUT)
- GOTO END^LROE
- SET LRSN=0
- SET LRMOR=0
- SET LRNN=0
- DO PT^LRX
- Q12 DO LOC^LRWU
- if LREND
- GOTO QUICK
- W13 IF '$DATA(LRQUICK)
- SET LRSN=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,LRSN))
- IF LRSN
- if 'LRMOR
- WRITE !,"ORDERED:"
- SET LRMOR=1
- if $DATA(^LRO(69,LRODT,1,LRSN,.1))
- WRITE !!,"ORDER #: ",+^(.1)
- DO SHORT
- GOTO W13
- +1 if $DATA(LRQUICK)!'LRMOR
- GOTO Q10
- +2 FOR I=0:0
- WRITE !,"Do you want an expanded list"
- SET %=2
- DO YN^DICN
- if %
- QUIT
- WRITE " Answer 'Y'es or 'N'o."
- +3 if %=-1
- GOTO QUICK
- if %'=1
- GOTO W16
- +4 SET DIC="^LRO(69,"_LRODT_",1,"
- SET DR="0:3"
- SET DA=0
- +5 WRITE !,"Order #",!," Test",?20,"Urgency",?30,"Status",?64,"Accession"
- +6 SET LRSVSN=LRSN
- SET LRSN=0
- SET LRSN=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,LRSN))
- if LRSN<1
- QUIT
- DO ORDER^LROS
- +7 SET LRSN=LRSVSN
- W16 IF $DATA(LRLONG)
- KILL LRDFN
- GOTO NEXT^LROE
- +1 WRITE !,"Is the test one of the above"
- SET %=2
- DO YN^DICN
- IF %'=2
- KILL LRDFN
- GOTO NEXT^LROE
- Q10 DO PRAC^LRWU1
- if LREND
- GOTO LREND
- +1 SET LRCCOM=""
- DO ^LROW1
- if LRTSTN=0
- GOTO NEXT^LROE
- W12 DO NOW^%DTC
- SET D1=%
- DO COLTY^LRWU
- if LREND
- GOTO LREND
- +1 SET LRSNO=LRDFN_"^"_DUZ_"^^"_LRLWC_"^"_D1_"^"_LRPRAC_"^"_LRLLOC
- +2 WRITE !!,PNM,?30,SSN
- +3 DO ^LROW3
- IF %["N"!(%["^")!($DATA(LRTEST)=1)
- DO W20^LROW
- GOTO NEXT^LROE
- +4 DO REST^LROW2
- SET LRSN=$ORDER(LRSN(0))
- if LRSN=""
- GOTO LREND
- SET LRSTATUS="C"
- DO P15
- if LRCDT<1
- GOTO LREND
- +5 SET LRI=LRSN
- FOR
- SET LRSN=$ORDER(LRSN(LRSN))
- if 'LRSN
- QUIT
- DO P15
- +6 ;LR*5.2*559: Deleting logic which adds .00001 to collection date/time.
- +7 ; Keeping LRSN in case it is needed downstream.
- +8 ;former line:
- +9 ;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)
- +10 SET LRSN=LRI
- +11 DO Q15^LROE2
- DO TASK^LROE
- GOTO NEXT^LROE
- Q15 ;from LROE
- +1 DO Q15^LROE2
- +2 QUIT
- P15 ;from LRVER,LRVR,LRGV
- +1 NEW COMB
- +2 SET E=0
- FOR
- SET E=$ORDER(^LRO(69,LRODT,1,LRSN,2,E))
- if 'E
- QUIT
- WRITE !,$PIECE(^LAB(60,+^(E,0),0),"^")
- +3 DO TIME^LROE
- if LRCDT<1
- QUIT
- SET LRUN=$PIECE(LRCDT,"^",2)
- SET LRTIM=+LRCDT
- SET LRNT=LRTIM
- SET $PIECE(^LRO(69,LRODT,1,LRSN,0),U,8)=LRTIM
- +4 IF '$DATA(LRCDT)
- SET (LRCDT,LRTIM,LRNT)=$PIECE(^LRO(69,LRODT,1,LRSN,0),U,8)
- SET LRUN=""
- +5 IF $PIECE(^(0),U,4)="LC"
- IF $DATA(^(1))
- SET LRLLOC=$PIECE(^(0),U,7)
- SET LROLLOC=$PIECE(^(0),U,9)
- SET LRNT=$SELECT($DATA(LRNT):LRNT,$DATA(LRTIM):LRTIM,$DATA(LRCDT):+LRCDT,1:"")
- DO P15^LRPHITEM
- QUIT
- +6 SET COMB=$PIECE($GET(^LRO(69,LRODT,1,LRSN,1)),"^",7)
- +7 SET ^LRO(69,LRODT,1,LRSN,1)=LRTIM_"^"_LRUN_"^"_DUZ_"^"_LRSTATUS_"^^^"_COMB_"^"_DUZ(2)
- if LRSTATUS="C"
- SET ^LRO(69,"AA",+$GET(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)=""
- QUIT
- SHORT ;Short list of tests
- +1 NEW X,I
- +2 SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,I))
- if I<1
- QUIT
- SET X=^(I,0)
- IF X
- WRITE !,$PIECE(^LAB(60,+X,0),U)
- IF $PIECE(X,"^",11)
- WRITE ?40," Canceled by: "_$PIECE(^VA(200,$PIECE(X,"^",11),0),"^")
- +3 QUIT
- LRSPEC SET LRSAMP=+$PIECE(^LRO(69,LRODT,1,LRSN,0),U,3)
- SET LRSPEC=$SELECT($DATA(^LAB(62,LRSAMP,0)):$PIECE(^(0),U,2),1:"")
- +1 IF 'LRSPEC
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,4,0))
- IF I
- IF $DATA(^(I,0))
- SET LRSPEC=$PIECE(^(0),U)
- LREND KILL DIR
- QUIT
