VistA-FOIAVistA/r/LAB_SERVICE-LR-LS/LR7OFA1.m

30 lines
2.1 KiB
Mathematica

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