| 1 | LRMIBL ;AVAMC/REG - BATCH ORDERING/ACCESSION LOGING ; 8/25/87 08:37 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121,153**;Sep 27, 1994
|
|---|
| 3 | ;from option LRMIBL
|
|---|
| 4 | BEGIN S LRBLEND=0 D BLOG
|
|---|
| 5 | END K %,A,DFN,DIC,DQ,DX,H8,J,K,L,LRAA,LRACC,LRAC,LRAN,LRBLEND,LRCCOM,LRCDT,LRCOM,LRCSN,LRDFN,LRDPF,LREAL,LREND,LREXP,LRIDT,LRIN,LRIX,LRLBLBP,LRLLOC,LRM,LRNT,LRORD,LROU,LROUTINE,LRPR,LRPRAC,LRRB,LRSN,LRSSP,LRSSX,LRST,LRSUM,LRSXN,LRTS,LRTSTNM
|
|---|
| 6 | K LRUNQ,LRWLC,LRWP,LRYR,PNM,S,SSN,X,X1,Y,Z,LRFIRST,DIC,LRSAME,LRSAMP,LRSPEC,LRORDR,LRECT,LRODT,LRURG,LRFLOG,LRCS,LROT,LRTN,LRTOP,LRTP,LRTSTN,LRTY,LRUR,LRUSNM,LRWL0,LRWPC,LRXL,S5
|
|---|
| 7 | K LRTCOM,%H,%X,%Y,DIWL,DIWR,DO,DPF,I1,I2,I5,LABEL,LRADDTST,LRBED,LRCE,LRCSS,LRDAT,LRDTO,LRECOM,LRINFW,LRLWC,LRMAX,LRNCWL,LRNIDT,LROCN,LROID,LROLRDFN,LRORDER,LRORDTIM,LROSN,LRPHSET,LRPREF,LRSLIP,LRSNO,LRSPCDSC,LRSVSN,LRTEST,LRTJ
|
|---|
| 8 | K ^TMP("LRSTIK",$J)
|
|---|
| 9 | Q
|
|---|
| 10 | BLOG K ^TMP("LRSTIK",$J),DIC,LRURG,LRSAME,LRCOM,LRTCOM S LRORDR="" D DT^LRX W !!," BATCH LOG-IN",!
|
|---|
| 11 | S LRODT=DT,U="^",LRECT=0,LROUTINE=$P(^LAB(69.9,1,3),U,2)
|
|---|
| 12 | F W !!,"WANT TO ENTER COLLECTION TIMES" S %=1 D YN^DICN S LRECT=$S(%=2:0,1:1) S:%<0 LRBLEND=1 Q:% W !,"Yes or No"
|
|---|
| 13 | Q:LRBLEND
|
|---|
| 14 | G1 S LRWP=0 F D GET Q:LRBLEND
|
|---|
| 15 | Q
|
|---|
| 16 | GET S DIC="^LAB(60,",DIC(0)="AEMOQ",DIC("S")="I ""AUSP""'[$P(^(0),U,4)!($P(^(0),U,4)="""")"_$S('$D(^XUSEC("LRLAB",DUZ)):"&(""NO""'[$P(^(0),U,3))",1:"")
|
|---|
| 17 | D ^DIC K DIC("S") S:Y<1 LRBLEND=1 Q:LRBLEND S LRWP=LRWP+1,^TMP("LRSTIK",$J,LRWP)=$P(Y,U,1,2),^TMP("LRSTIK",$J,"B",LRWP)=LRWP
|
|---|
| 18 | S LRTSTS=+^TMP("LRSTIK",$J,LRWP) D GS^LRORD3 S:+LRSAMP=-1&(LRSPEC=-1) LRBLEND=1 Q:LRBLEND S ^TMP("LRSTIK",$J,LRWP)=^TMP("LRSTIK",$J,LRWP)_U_LRSAMP_U_U_LRSPEC
|
|---|
| 19 | G5 S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)=""
|
|---|
| 20 | S LRSSX=LRWP,LRST=0,LRSAMP=$P(^TMP("LRSTIK",$J,LRSSX),U,3),LRSPEC=$P(^TMP("LRSTIK",$J,LRSSX),U,5),LRTSTS=+^TMP("LRSTIK",$J,LRSSX) D Q20,URGG
|
|---|
| 21 | S LRM=0,PNM="",SSN="" D ENSTIK^LROW3 Q:'$D(LROT) S:'$D(%) LRWP=0 Q:'$D(%) S:%["N" LRBLEND=1 Q:LRBLEND S %X="LROT(",%Y="LROU(" D %XY^%RCR
|
|---|
| 22 | F D L2 Q:LRBLEND
|
|---|
| 23 | Q
|
|---|
| 24 | L2 K LRSAME,LRGCOM,DFN,DIC S PNM="",DIC(0)="EMQ"_$S($P(LRPARAM,U,6)&$D(^XUSEC("LRLAB",DUZ)):"L",1:"") W ! D ^LRDPA I (LRDFN=-1)!$D(DUOUT)!$D(DTOUT) S LRBLEND=1 Q
|
|---|
| 25 | S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
|
|---|
| 26 | D LOC^LRWU D:LREND DROP Q:LREND D PRAC^LRWU1 I LREND D DROP Q
|
|---|
| 27 | D ORDER^LROW2
|
|---|
| 28 | S II=0
|
|---|
| 29 | F S II=$O(LROT(II)) Q:II<1 D
|
|---|
| 30 | . S J=0
|
|---|
| 31 | . F S J=$O(LROT(II,J)) Q:J<1 D
|
|---|
| 32 | . . S K=0
|
|---|
| 33 | . . F S K=$O(LROT(II,J,K)) Q:K<1 S ^LRO(69,LRODT,1,"AB",$S($D(^TMP("LRSTIK",$J,K)):+^TMP("LRSTIK",$J,K),1:+LROT(II,J,K)),J,LRDFN)=""
|
|---|
| 34 | I LRECT D TIME^LRWU1 I LRCDT<1 D DROP Q
|
|---|
| 35 | S LRORDTIM=$P($H,",",2)\3600*100+($P($H,",",2)\60#60)/10000,LRNT=LRORDTIM+DT,LRORDTIM=$P(LRORDTIM,".",2) S:'LRECT LRCDT=LRNT_"^1"
|
|---|
| 36 | S LRIDT=9999999-LRCDT
|
|---|
| 37 | S %X="LROU(",%Y="LROT(" D %XY^%RCR D ^LRORDST
|
|---|
| 38 | Q
|
|---|
| 39 | Q20 D:LRSAMP="" GSS^LRORD3 I (LRSAMP<1)!(LRSPEC<1) W !,"Sample and source incompletely defined, test skipped." K LRSAME Q
|
|---|
| 40 | S LROT(LRSAMP,LRSPEC,LRSSX)=LRTSTS D:LRST URGG
|
|---|
| 41 | S LREXP=$S($D(^LAB(60,LRTSTS,3,+LRSAMP,0)):$P(^(0),U,6),$P(^LAB(60,LRTSTS,0),U,19):$P(^(0),U,19),1:0) S:LREXP LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP
|
|---|
| 42 | Q
|
|---|
| 43 | URGG W !,"For ",$P(^TMP("LRSTIK",$J,LRWP),U,2) D URG^LRORD2
|
|---|
| 44 | Q
|
|---|
| 45 | DROP W !!,"ORDER CANCELED",$C(7),!!
|
|---|
| 46 | Q
|
|---|
| 47 | ;LRORDR =TYPE OF ORDER, LRECT =ASK COLECTION TIME
|
|---|
| 48 | ;LRFLOG =ACCESSION TEST GROUP, IF DEFINED ON ENTRY, PRESELECTS GROUP
|
|---|
