LR7OFA1 ;slc/dcm - Setup new order from OE/RR for AP ;8/11/97
;;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
Q
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)=""
Q
DT S DT=$$DT^XLFDT()
S LRNT=$P($H,",",2),LRNT=LRNT\3600*100+(LRNT\60#60)/10000+DT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OFA1 2173 printed Apr 09, 2024@21:08:01 Page 2
LR7OFA1 ;slc/dcm - Setup new order from OE/RR for AP ;8/11/97
+1 ;;5.2;LAB SERVICE;**121,187,256**;Sep 27, 1994
+2 ;
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
