LRAD2ORD.m

LRAD2ORD ;SLC/CJS - ADD TESTS TO AN EXISTING ORDER ;8/11/97 [ 04/08/2003  6:44 AM ]

 ;;5.2T9;LR;**1003,1004,1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**100,121,153**;Sep 27, 1994

 K LRNATURE

 ;----- BEGIN IHS MODOFICATIONS - LR*5.2*1018

 ;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

 S LR2ORD=1,LRADDTST="",LRNOP=0 S:$G(BLROPT)=""!($G(BLROPT(0))'=$P(XQY0,U)) BLROPT="ADDORD",BLROPT(0)=$P(XQY0,U) D ^LRCE I LRNOP W !,"Tests have been accessioned, call the lab to add tests to the same order." G END  ;IHS/OIRM TUC/AAB2/1/97

 ;----- END IHS MODIFICATIONS - LR*5.2*1018

 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

 ;----- BEGIN IHS MODIFICATIONS - LR*5.2*1018

 ;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 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,HRCN,J,K,S,X,Y,LRSN1,LRSAME,ZTSK

 ;----- END IHS MODIFICATIONS - LR*5.2*1018

 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

LRAD2ORD  ;SLC/CJS - ADD TESTS TO AN EXISTING ORDER ;8/11/97 [ 04/08/2003  6:44 AM ]

 +1       ;;5.2T9;LR;**1003,1004,1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**100,121,153**;Sep 27, 1994

 +3        KILL LRNATURE

 +4       ;----- BEGIN IHS MODOFICATIONS - LR*5.2*1018

 +5       ;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

 +6       ;IHS/OIRM TUC/AAB2/1/97

           SET LR2ORD=1

           SET LRADDTST=""

           SET LRNOP=0

           IF $GET(BLROPT)=""!($GET(BLROPT(0))'=$PIECE(XQY0,U))

               SET BLROPT="ADDORD"

               SET BLROPT(0)=$PIECE(XQY0,U)

           DO ^LRCE

           IF LRNOP

               WRITE !,"Tests have been accessioned, call the lab to add tests to the same order."

               GOTO END

 +7       ;----- END IHS MODIFICATIONS - LR*5.2*1018

 +8        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       ;----- BEGIN IHS MODIFICATIONS - LR*5.2*1018

 +2       ;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

 +3        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,HRCN,J,K,S,X,Y,LRSN1,LRSAME,ZTSK

 +4       ;----- END IHS MODIFICATIONS - LR*5.2*1018

 +5        KILL LRSN1,LRNOP

 +6        KILL LRMAX1,LRMAX2,LRODTSV,LROLLOC,LROT,LRRB,LRRSTAT,LRSNSV,LRTREA,LRUNQ,TT

 +7        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