source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROW2.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1LROW2 ;SLC/CJS - TEST & SAMPLE VERIFICATION ;8/11/97
2 ;;5.2;LAB SERVICE;**121,290**;Sep 27, 1994
3COL S $P(^LRO(69,LRODT,1,LRSN,0),U,2)=DUZ Q
4REST ;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
9PAST 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
13ORDER ;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!
16NEXT 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
23CHECK ;from LROE1
24 S D=0 F S D=$O(^LRO(69,"C",LRORD,D)) Q:D<1 D C2
25 Q
26C2 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
28BAD ;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
30DUPL ;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
33TCOM ;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 %
37OR ;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
Note: See TracBrowser for help on using the repository browser.