source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OFA1.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1LR7OFA1 ;slc/dcm - Setup new order from OE/RR for AP ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,256**;Sep 27, 1994
3 ;
4EN ;Setup orders from OE/RR for AP
5 D DT K ZTSK S LRORDR=LRXZ
6 F LRSAMP=-1:0 S LRSAMP=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP)) Q:LRSAMP="" S ORIFN=^(LRSAMP,0) D ZX
7 K ZTSK Q
8ZX ;
9 S (LRSXN,I)=0 F S I=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,I)) Q:I<1 S LRSXN=LRSXN+1
10 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)=""
11LOCK 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)
12ZSN IF $D(^LRO(69,LRODT,1,LRSN,0)) S LRSN=LRSN+1 G ZSN
13 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
14 L -^LRO(69,LRODT,1)
15 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)=""
16 S ^LRO(69,LRODT,1,LRSN,.1)=LRORD,^LRO(69,"C",+LRORD,LRODT,LRSN)="",J=0
17 F LRJ=1:1 S J=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J)) Q:J<1 D ZSN1 D
18 .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
19 ..F I=1:1:X S ^LRO(69,LRODT,1,LRSN,6,I,0)=^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,J,I)
20 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
21 I LRXZ["I" S ION=$P($G(^LAB(69.9,1,7,DUZ(2),0)),U,3) D ^LROW2P
22 Q
23ZSN1 S LRTSTS=+^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J),LRORIFN=^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,J,0)
24 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:"")
25 S ^LRO(69,LRODT,1,LRSN,2,"B",LRTSTS,LRJ)=""
26 Q
27DT S DT=$$DT^XLFDT()
28 S LRNT=$P($H,",",2),LRNT=LRNT\3600*100+(LRNT\60#60)/10000+DT
29 Q
Note: See TracBrowser for help on using the repository browser.