LRUWLF.m

LRUWLF ; IHS/DIR/AAB - FILE #68 UTILITY 3/28/96 06:32 ; [ 07/22/2002  1:56 PM ]

 ;;5.2;LR;**1002,1013**;JUL 15, 2002

 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 S:'$D(LRCS) LRCS=""

STF S:'$D(LRSIT) LRSIT=LRU S:'$D(LRSVC) LRSVC=""

 S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^"_+LRDPF_"^"_LRRC_"^^^^"_LRLLOC_"^"_LRMD(1)_"^"_LRSVC_"^"_DUZ_"^"_LRCAPLOC,^(3)=LRSD_"^^"_LRRC_"^^"_LRI_"^"_LRC(5),^(.2)=LRABV_" "_LRWHN_" "_LRAN,^(.4)=DUZ(2)

 K LRSD S ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)=""

 S ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""

 I LRSS="CY" S ^LRO(69.2,LRAA,1,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0) L +^LRO(69.2,LRAA,1) S X=^LRO(69.2,LRAA,1,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,1)

 Q

EN1 ;add more tests ;used by LRUTAD

 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^^"

 W !

TST K LRTEST

 S DIC=60,DIC("A")="   Add Test/Procedure: ",DIC(0)="AEMOQZ",DIC("S")="I $P(^(0),U,4)=LRAA(2),$A($P(^(0),U,3))<78" D ^DIC K DIC I Y<1 S LRSIT="" Q

 S (LRTEST,Y)=+Y,LRTNAM=$P(Y,U,2)

 S N=0 F A=0:0 S N=$O(^LAB(60,LRTEST,1,N)) Q:'N  S LRTEST(1)=$S($D(^LAB(60,LRTEST,1,N,0)):+^LAB(60,LRTEST,1,N,0),1:"") Q:LRTEST(1)=LRSIT

 I LRSS="CH",N<1 W $C(7),!!,"CANNOT ORDER ",LRTNAM," FOR ",$P(^LAB(61,LRSIT,0),U) G TST

 D SUM K LRRP G TST

SUM ;

 S N=0 F X=0:1 S N=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,N)) Q:'N  S:Y=N LRRP=1

 Q:$D(LRRP)  S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,Y,0)=LRTEST_"^^" I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),"^",4)<1 S ^(0)="^68.04PA^"_Y_"^"_1 Q

 S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_Y_"^"_($P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),"^",4)+1) Q

 Q

LRUWLF    ; IHS/DIR/AAB - FILE #68 UTILITY 3/28/96 06:32 ; [ 07/22/2002  1:56 PM ]

 +1       ;;5.2;LR;**1002,1013**;JUL 15, 2002

 +2       ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 +3        IF '$DATA(LRCS)

               SET LRCS=""

STF        IF '$DATA(LRSIT)

               SET LRSIT=LRU

           IF '$DATA(LRSVC)

               SET LRSVC=""

 +1        SET ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^"_+LRDPF_"^"_LRRC_"^^^^"_LRLLOC_"^"_LRMD(1)_"^"_LRSVC_"^"_DUZ_"^"_LRCAPLOC

           SET ^(3)=LRSD_"^^"_LRRC_"^^"_LRI_"^"_LRC(5)

           SET ^(.2)=LRABV_" "_LRWHN_" "_LRAN

           SET ^(.4)=DUZ(2)

 +2        KILL LRSD

           SET ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)=""

 +3        SET ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""

 +4        IF LRSS="CY"

               SET ^LRO(69.2,LRAA,1,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0)

               LOCK +^LRO(69.2,LRAA,1)

               SET X=^LRO(69.2,LRAA,1,0)

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRAN_"^"_($PIECE(X,"^",4)+1)

               LOCK -^LRO(69.2,LRAA,1)

 +5        QUIT 

EN1       ;add more tests ;used by LRUTAD

 +1        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))

               SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^^"

 +2        WRITE !

TST        KILL LRTEST

 +1        SET DIC=60

           SET DIC("A")="   Add Test/Procedure: "

           SET DIC(0)="AEMOQZ"

           SET DIC("S")="I $P(^(0),U,4)=LRAA(2),$A($P(^(0),U,3))<78"

           DO ^DIC

           KILL DIC

           IF Y<1

               SET LRSIT=""

               QUIT 

 +2        SET (LRTEST,Y)=+Y

           SET LRTNAM=$PIECE(Y,U,2)

 +3        SET N=0

           FOR A=0:0

               SET N=$ORDER(^LAB(60,LRTEST,1,N))

               IF 'N

                   QUIT 

               SET LRTEST(1)=$SELECT($DATA(^LAB(60,LRTEST,1,N,0)):+^LAB(60,LRTEST,1,N,0),1:"")

               IF LRTEST(1)=LRSIT

                   QUIT 

 +4        IF LRSS="CH"

               IF N<1

                   WRITE $CHAR(7),!!,"CANNOT ORDER ",LRTNAM," FOR ",$PIECE(^LAB(61,LRSIT,0),U)

                   GOTO TST

 +5        DO SUM

           KILL LRRP

           GOTO TST

SUM       ;

 +1        SET N=0

           FOR X=0:1

               SET N=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,N))

               IF 'N

                   QUIT 

               IF Y=N

                   SET LRRP=1

 +2        IF $DATA(LRRP)

               QUIT 

           SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,Y,0)=LRTEST_"^^"

           IF $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),"^",4)<1

               SET ^(0)="^68.04PA^"_Y_"^"_1

               QUIT 

 +3        SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_Y_"^"_($PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),"^",4)+1)

           QUIT 

 +4        QUIT