| 1 | LROW2 ;SLC/CJS - TEST & SAMPLE VERIFICATION ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121,290**;Sep 27, 1994
|
|---|
| 3 | COL S $P(^LRO(69,LRODT,1,LRSN,0),U,2)=DUZ Q
|
|---|
| 4 | REST ;from LRFAST, LROE1, LROW
|
|---|
| 5 | I '$D(LRNCWL),'$D(LRORDER) K %ZIS S IOP="P",%ZIS="N" D ^%ZIS K %ZIS,IOP S:'POP LRORDER=ION I POP S %ZIS="NQ",%ZIS("A")="ORDER COPY DEVICE:" D ^%ZIS S:'POP LRORDER=ION I POP S IOP="HOME" D ^%ZIS
|
|---|
| 6 | S LRLLOC=$P(LRSNO,U,7),LRSSP=-1
|
|---|
| 7 | I $D(LRADDTST) S LRORD=+LRADDTST,LRADDTST="" G PAST
|
|---|
| 8 | D ORDER
|
|---|
| 9 | PAST S J=0 D CHECK:$D(LRADDTST) G BAD:J K LRXS S LRCS=0 F J=0:0 S LRCS=$O(LRXST(LRCS)) Q:LRCS<1 S T=0 F S T=$O(LRXST(LRCS,T)) Q:T<1 S LRXS(LRCS,LRXST(LRCS,T),T)=""
|
|---|
| 10 | S LRSSP=0 F S LRSSP=$O(LRXS(LRSSP)) Q:LRSSP<1 S LRSPEC=0 F S LRSPEC=$O(LRXS(LRSSP,LRSPEC)) Q:LRSPEC<1 D DUP^LROW2A
|
|---|
| 11 | W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
|
|---|
| 12 | Q
|
|---|
| 13 | ORDER ;from LRMIBL, LROE1, LRORD1, LRQCLOG
|
|---|
| 14 | N LRYR
|
|---|
| 15 | S LRYR=$E(DT,1,3)_"0000" I '$D(^LRO(69,LRYR,2)) S ^LRO(69,LRYR,0)=LRYR,^(2)=0,^LRO(69,"B",LRYR,LRYR)="" ;HAPPY NEW YEAR!
|
|---|
| 16 | NEXT L +^LRO(69,LRYR,2) S LRORD=1+^LRO(69,LRYR,2) F Q:'$D(^LRO(69,"C",LRORD)) S LRORD=LRORD+1
|
|---|
| 17 | S ^LRO(69,LRYR,2)=LRORD L -^LRO(69,LRYR,2)
|
|---|
| 18 | S J=0 D CHECK G NEXT:J
|
|---|
| 19 | Q:$G(LRQUIET)
|
|---|
| 20 | W:'$D(ZTQUEUED) !,"LAB Order number: ",LRORD
|
|---|
| 21 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 22 | Q
|
|---|
| 23 | CHECK ;from LROE1
|
|---|
| 24 | S D=0 F S D=$O(^LRO(69,"C",LRORD,D)) Q:D<1 D C2
|
|---|
| 25 | Q
|
|---|
| 26 | C2 S S=0 F S S=$O(^LRO(69,"C",LRORD,D,S)) Q:S<1 I $D(^LRO(69,D,1,S,0)),LRDFN'=+^(0) S J=1 Q
|
|---|
| 27 | Q
|
|---|
| 28 | BAD ;from LROE1
|
|---|
| 29 | W !,"The ORDER NUMBER is in use, contact the site manager.",$C(7),!,"This order has been CANCELED, you will need to re-order.",! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
|
|---|
| 30 | DUPL ;from LROW1
|
|---|
| 31 | S LREND=1 W !,"Since this test, collection sample, and site/specimen has already",!,"been requested on this order, it will NOT be duplicated.",$C(7),!,"If you really need a duplicate, place a separate order."
|
|---|
| 32 | Q
|
|---|
| 33 | TCOM ;from LROW1
|
|---|
| 34 | S LRCCOM="~For Test: "_$P(^LAB(60,+LRTEST(LRTSTN),0),U)_" "_$P(^LAB(62,LRSAMP,0),U) S:$P(^(0),U)'=$P(^LAB(61,LRSPEC,0),U) LRCCOM=LRCCOM_" "_$P(^LAB(61,LRSPEC,0),U) W !,LRCCOM
|
|---|
| 35 | D RCS^LRORD2 Q
|
|---|
| 36 | % R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
|
|---|
| 37 | OR ;OE/RR 2.5
|
|---|
| 38 | Q ;Following logic not required - 2.5 is obsolete version
|
|---|
| 39 | S LRORIFN=$P(LRTEST(LRI),"^",7) I 'LRORIFN D SET^LROR S $P(LRTEST(LRI),"^",7)=LRORIFN Q
|
|---|
| 40 | S ORIFN=LRORIFN,ORETURN("ORPK")=LRODT_"^"_LRSN_"^"_LRTN D RETURN^ORX:ORIFN
|
|---|
| 41 | Q
|
|---|
