Routine: LR7OFA1

LR7OFA1 ;slc/dcm - Setup new order from OE/RR for AP ;8/11/97

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

 ;;5.2;LAB SERVICE;**121,187,256**;Sep 27, 1994

EN ;Setup orders from OE/RR for AP

 D DT K ZTSK S LRORDR=LRXZ

 F LRSAMP=-1:0 S LRSAMP=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP)) Q:LRSAMP=""  S ORIFN=^(LRSAMP,0) D ZX

 K ZTSK Q

ZX ;

 S (LRSXN,I)=0 F  S I=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,I)) Q:I<1  S LRSXN=LRSXN+1

 S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_"^"_LRODT_"^"_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)=""

LOCK L +^LRO(69,LRODT,1) G:'$T LOCK S LRSN=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),U,3),1:0),LRSUM=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),U,4),1:0)

ZSN IF $D(^LRO(69,LRODT,1,LRSN,0)) S LRSN=LRSN+1 G ZSN

 S ^LRO(69,LRODT,1,LRSN,0)=LRDFN_"^"_DUZ_"^"_(+LRSAMP)_"^"_LRORDR_"^"_LRNT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRSDT_"^"_LROLLOC_"^^"_ORIFN,^(2,0)="^69.03PA^"_LRSXN_"^"_LRSXN,^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_"^"_LRSUM

 L -^LRO(69,LRODT,1)

 S ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)="",^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,"SN")=LRSN,^LRO(69,"D",LRDFN,LRODT,LRSN)="" S:$L(LRLLOC) ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""

 S ^LRO(69,LRODT,1,LRSN,.1)=LRORD,^LRO(69,"C",+LRORD,LRODT,LRSN)="",J=0

 F LRJ=1:1 S J=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J)) Q:J<1  D ZSN1 D

 .I $D(^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,J)),$O(^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,J,0)) S X=^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,J),^LRO(69,LRODT,1,LRSN,6,0)="^69.04W^"_X_"^"_X D

 ..F I=1:1:X S ^LRO(69,LRODT,1,LRSN,6,I,0)=^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,J,I)

 I LRORDR="LC" S ION=$P($G(^LAB(69.9,1,3.5,+DUZ(2),0)),U,2) S:ION="" ION=$P(^LAB(69.9,1,3),U,4) I ION]"" D ^LROW2P

 I LRXZ["I" S ION=$P($G(^LAB(69.9,1,7,DUZ(2),0)),U,3) D ^LROW2P

ZSN1 S LRTSTS=+^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J),LRORIFN=^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J,0)

 S ^LRO(69,LRODT,1,LRSN,2,LRJ,0)=LRTSTS_"^"_$S($D(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J,1)):^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J,1),1:LROUTINE)_$S($D(LRORIFN):"^^^^^"_LRORIFN,1:"")

 S ^LRO(69,LRODT,1,LRSN,2,"B",LRTSTS,LRJ)=""

DT S DT=$$DT^XLFDT()

 S LRNT=$P($H,",",2),LRNT=LRNT\3600*100+(LRNT\60#60)/10000+DT

LR7OFA1   ;slc/dcm - Setup new order from OE/RR for AP ;8/11/97

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

 +2       ;;5.2;LAB SERVICE;**121,187,256**;Sep 27, 1994

 +3       ;

EN        ;Setup orders from OE/RR for AP

 +1        DO DT

           KILL ZTSK

           SET LRORDR=LRXZ

 +2        FOR LRSAMP=-1:0

               SET LRSAMP=$ORDER(^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP))

               IF LRSAMP=""

                   QUIT

               SET ORIFN=^(LRSAMP,0)

               DO ZX

 +3        KILL ZTSK

           QUIT

ZX        ;

 +1        SET (LRSXN,I)=0

FOR

               SET I=$ORDER(^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,I))

               IF I<1

                   QUIT

               SET LRSXN=LRSXN+1

 +2        IF '$DATA(^LRO(69,LRODT,0))

               SET ^(0)=$PIECE(^LRO(69,0),U,1,2)_"^"_LRODT_"^"_(1+$PIECE(^(0),U,4))

               SET ^LRO(69,LRODT,0)=LRODT

               SET ^LRO(69,"B",LRODT,LRODT)=""

LOCK       LOCK +^LRO(69,LRODT,1)

           IF '$TEST

               GOTO LOCK

           SET LRSN=1+$SELECT($DATA(^LRO(69,LRODT,1,0)):$PIECE(^(0),U,3),1:0)

           SET LRSUM=1+$SELECT($DATA(^LRO(69,LRODT,1,0)):$PIECE(^(0),U,4),1:0)

ZSN        IF $DATA(^LRO(69,LRODT,1,LRSN,0))

               SET LRSN=LRSN+1

               GOTO ZSN

 +1        SET ^LRO(69,LRODT,1,LRSN,0)=LRDFN_"^"_DUZ_"^"_(+LRSAMP)_"^"_LRORDR_"^"_LRNT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRSDT_"^"_LROLLOC_"^^"_ORIFN

           SET ^(2,0)="^69.03PA^"_LRSXN_"^"_LRSXN

           SET ^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_"^"_LRSUM

 +2        LOCK -^LRO(69,LRODT,1)

 +3        SET ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)=""

           SET ^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,"SN")=LRSN

           SET ^LRO(69,"D",LRDFN,LRODT,LRSN)=""

           IF $LENGTH(LRLLOC)

               SET ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""

 +4        SET ^LRO(69,LRODT,1,LRSN,.1)=LRORD

           SET ^LRO(69,"C",+LRORD,LRODT,LRSN)=""

           SET J=0

 +5        FOR LRJ=1:1

               SET J=$ORDER(^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,J))

               IF J<1

                   QUIT

               DO ZSN1

               Begin DoDot:1

 +6                IF $DATA(^TMP("OR",$JOB,"COM",LRSDT,LRXZ,LRSAMP,J))

                       IF $ORDER(^TMP("OR",$JOB,"COM",LRSDT,LRXZ,LRSAMP,J,0))

                           SET X=^TMP("OR",$JOB,"COM",LRSDT,LRXZ,LRSAMP,J)

                           SET ^LRO(69,LRODT,1,LRSN,6,0)="^69.04W^"_X_"^"_X

                           Begin DoDot:2

 +7                            FOR I=1:1:X

                                   SET ^LRO(69,LRODT,1,LRSN,6,I,0)=^TMP("OR",$JOB,"COM",LRSDT,LRXZ,LRSAMP,J,I)

                           End DoDot:2

               End DoDot:1

 +8        IF LRORDR="LC"

               SET ION=$PIECE($GET(^LAB(69.9,1,3.5,+DUZ(2),0)),U,2)

               IF ION=""

                   SET ION=$PIECE(^LAB(69.9,1,3),U,4)

               IF ION]""

                   DO ^LROW2P

 +9        IF LRXZ["I"

               SET ION=$PIECE($GET(^LAB(69.9,1,7,DUZ(2),0)),U,3)

               DO ^LROW2P

 +10       QUIT

ZSN1       SET LRTSTS=+^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,J)

           SET LRORIFN=^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,J,0)

 +1        SET ^LRO(69,LRODT,1,LRSN,2,LRJ,0)=LRTSTS_"^"_$SELECT($DATA(^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,J,1)):^TMP("OR",$JOB,"LROT",LRSDT,LRXZ,LRSAMP,J,1),1:LROUTINE)_$SELECT($DATA(LRORIFN):"^^^^^"_LRORIFN,1:"")

 +2        SET ^LRO(69,LRODT,1,LRSN,2,"B",LRTSTS,LRJ)=""

 +3        QUIT

DT         SET DT=$$DT^XLFDT()

 +1        SET LRNT=$PIECE($HOROLOG,",",2)

           SET LRNT=LRNT\3600*100+(LRNT\60#60)/10000+DT

 +2        QUIT

LR7OFA1.m