LRAD2ORD ;SLC/CJS - ADD TESTS TO AN EXISTING ORDER ;8/11/97
;;5.2;LAB SERVICE;**100,121,153**;Sep 27, 1994
K LRNATURE
S LR2ORD=1,LRADDTST="",LRNOP=0 D ^LRCE I LRNOP W !,"Tests have been accessioned, call the lab to add tests to the same order." G END
I 'LRNOP&LRADDTST S LRODT=$O(^LRO(69,"C",LRADDTST,0)),LRSN=$O(^(LRODT,0)),LRPRAC=$P(^LRO(69,LRODT,1,LRSN,0),U,6),LRORDTIM=$P($P(^(0),U,8),".",2) D A
END K X3,T,LRADDTST,LRNOP,LRFLOG,LRIOZERO,LRGCOM,LRM,LRNCWL,LRORDER,LRORDTIM,LRORIFN,LRSSX,LRSTIK,LRSVSN,LRTSTNM,LRTXD,LRTXP,LRWPC,LRBED,LRCCOM,LRCDT,LRCOM,LRCS,LRCSN,LRCSP,LRCSS,LRCSX,LRDFN,LRDPF,LRDTO,LREND,LREXP,LRI,LRIO,LRLLOC,LRLWC
K LRTCOM,LR2ORD,LRMAX,LRMOR,LRNN,LRODT,LRORD,LRPR,LRPRAC,LRSAMP,LRTSTN,LRSN,LRSNO,LRSPEC,LRSSP,LRTEST,LRTIME,LRTN,LRTP,LRTSN,LRTY,LRUR,LRUSI,LRUSNM,LRXS,LRXST,LRY,PNM,SEX,SSN,J,K,S,X,Y,LRSN1,LRSAME,ZTSK
K LRSN1,LRNOP
K LRMAX1,LRMAX2,LRODTSV,LROLLOC,LROT,LRRB,LRRSTAT,LRSNSV,LRTREA,LRUNQ,TT
Q
A S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRADDTST,LRODT,LRSN)) Q:LRSN<1 S X=^LRO(69,LRODT,1,LRSN,0),LRSAMP=$P(X,U,3),LRSPEC=$S($D(^(4,1,0)):+^(0),1:0) I LRSPEC,LRSAMP D B
K T S DA=0 F S DA=$O(^LRO(69,LRODT,1,"AA",LRDFN,DA)) Q:DA<1 I $S($D(^LRO(69,LRODT,1,DA,1)):$P(^(1),U,4)'="U",1:1) S S=$S($D(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0) S I=0 F S I=$O(^LRO(69,LRODT,1,DA,2,I)) Q:I<1 S T(+^(I,0),DA)=S
D ADD^LROW
Q
B S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 S X3(+^(I,0),LRSAMP,LRSPEC)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAD2ORD 1452 printed Dec 13, 2024@02:06:41 Page 2
LRAD2ORD ;SLC/CJS - ADD TESTS TO AN EXISTING ORDER ;8/11/97
+1 ;;5.2;LAB SERVICE;**100,121,153**;Sep 27, 1994
+2 KILL LRNATURE
+3 SET LR2ORD=1
SET LRADDTST=""
SET LRNOP=0
DO ^LRCE
IF LRNOP
WRITE !,"Tests have been accessioned, call the lab to add tests to the same order."
GOTO END
+4 IF 'LRNOP&LRADDTST
SET LRODT=$ORDER(^LRO(69,"C",LRADDTST,0))
SET LRSN=$ORDER(^(LRODT,0))
SET LRPRAC=$PIECE(^LRO(69,LRODT,1,LRSN,0),U,6)
SET LRORDTIM=$PIECE($PIECE(^(0),U,8),".",2)
DO A
END KILL X3,T,LRADDTST,LRNOP,LRFLOG,LRIOZERO,LRGCOM,LRM,LRNCWL,LRORDER,LRORDTIM,LRORIFN,LRSSX,LRSTIK,LRSVSN,LRTSTNM,LRTXD,LRTXP,LRWPC,LRBED,LRCCOM,LRCDT,LRCOM,LRCS,LRCSN,LRCSP,LRCSS,LRCSX,LRDFN,LRDPF,LRDTO,LREND,LREXP,LRI,LRIO,LRLLOC,LRLWC
+1 KILL LRTCOM,LR2ORD,LRMAX,LRMOR,LRNN,LRODT,LRORD,LRPR,LRPRAC,LRSAMP,LRTSTN,LRSN,LRSNO,LRSPEC,LRSSP,LRTEST,LRTIME,LRTN,LRTP,LRTSN,LRTY,LRUR,LRUSI,LRUSNM,LRXS,LRXST,LRY,PNM,SEX,SSN,J,K,S,X,Y,LRSN1,LRSAME,ZTSK
+2 KILL LRSN1,LRNOP
+3 KILL LRMAX1,LRMAX2,LRODTSV,LROLLOC,LROT,LRRB,LRRSTAT,LRSNSV,LRTREA,LRUNQ,TT
+4 QUIT
A SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"C",LRADDTST,LRODT,LRSN))
if LRSN<1
QUIT
SET X=^LRO(69,LRODT,1,LRSN,0)
SET LRSAMP=$PIECE(X,U,3)
SET LRSPEC=$SELECT($DATA(^(4,1,0)):+^(0),1:0)
IF LRSPEC
IF LRSAMP
DO B
+1 KILL T
SET DA=0
FOR
SET DA=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,DA))
if DA<1
QUIT
IF $SELECT($DATA(^LRO(69,LRODT,1,DA,1)):$PIECE(^(1),U,4)'="U",1:1)
SET S=$SELECT($DATA(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0)
SET I=0
FOR
SET I=$ORDER(^LRO(69,LRODT,1,DA,2,I))
if I<1
QUIT
SET T(+^(I,0),DA)=S
+2 DO ADD^LROW
+3 QUIT
B SET I=0
FOR
SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,I))
if I<1
QUIT
SET X3(+^(I,0),LRSAMP,LRSPEC)=""
+1 QUIT
