source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROR6B.m@ 700

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1LROR6B ;SLC/DCM/RWA - EDIT UNRELEASED LAB ORDERS FOR OE/RR CONT;9/11/89 16:55 ;
2 ;;5.2;LAB SERVICE;**24,100,128**;Sep 27, 1994
3SET K ^XUTL("OR",$J,"LROT",LROOST,LROXZ,LROSAMP,LROSPEC,LROCNT)
4 I '$D(^XUTL("OR",$J,"LROT",LROST,LRZX(1))) S ZTQUEUED=1 D ORDER^LROW2 K ZTQUEUED S ^XUTL("OR",$J,"LROT",LROST,LRZX(1))=LRORD
5 S LRORD=^XUTL("OR",$J,"LROT",LROST,LRZX(1))
6 S ^XUTL("OR",$J,"LROT",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT,1)=LRURG,^XUTL("OR",$J,"LROT",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT,0)=ORIFN,^XUTL("OR",$J,"LROT",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT)=LRTST
7 S ORIT=LRTST_";LAB(60,",ORETURN("ORPK")=LRTST_"^"_LROST_"^"_LRSAMP_"^"_LRSPEC_"^"_LRZX(1)_"^"_LRURG_"^"_LRORD_"^"_LROCNT,ORETURN("ORSTRT")=LROST
8 S X=$S($D(LRSAMP):$S($D(^LAB(62,+LRSAMP,0)):$P(^(0),"^"),1:""),1:""),Y=$S($D(LRSPEC):$S($D(^LAB(61,+LRSPEC,0)):$P(^(0),"^"),1:""),1:"")
9 S ORTX(1)=LRTSTNM_$S(Y'[X!(X=Y):" "_X,1:"")_$S(X'[Y:" "_Y,1:"")
10 S ORTX(1)=ORTX(1)_" "_$S($D(LRZX(1)):LRZX(1),1:"")_$S(LRURG=9!('LRURG):"",1:" "_$P(^LAB(62.05,LRURG,0),"^"))
11 S ORETURN("ORTX",1)=ORTX(1)
12 I $D(^XUTL("OR",$J,"COM",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT)) S CNT=2,I=0 F S I=$O(^XUTL("OR",$J,"COM",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT,I)) Q:I<1 D
13 .I ^XUTL("OR",$J,"COM",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT,I)'["~For" S ORETURN("ORTX",CNT)=^XUTL("OR",$J,"COM",LROST,LRZX(1),LRSAMP,LRSPEC,LROCNT,I),CNT=CNT+1
14 K ORTX
15 Q
Note: See TracBrowser for help on using the repository browser.