source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRWLST12.m@ 642

LRWLST12 ;SLC/CJS/RWF/FHS - ACCESSION SETUP ; 9/9/87  15:41 ;
 ;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
CAP ;from LRWLST11,LRTSTJAM
 N LRCNT,LA7V
 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2
 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))#2 ^(0)="^68.04PA" S $P(^(0),U,3)=+LRTS,$P(^(0),U,4)=1+$P(^(0),U,4)
 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,0))#2 ^(0)=LRTS,$P(^(0),U,9)=+$G(LRTSORU)
 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",+LRTS,+LRTS)) ^(+LRTS)=""
VMSG S LA7V=""
 I $G(LR696IEN),$D(^LRO(69.6,LR696IEN,0))#2 D
 . S $P(^LRO(69.6,LR696IEN,0),U,10)=160,LRCNT=0
 . F  S LRCNT=$O(LROT(LRSAMP,LRSPEC,LRCNT)) Q:LRCNT<1  I $D(LROT(LRSAMP,LRSPEC,LRCNT,"B",+LRTS))#2 S LRTSN=LROT(LRSAMP,LRSPEC,LRCNT,"B",+LRTS) D
 . . I $D(^LRO(69.6,LR696IEN,2,+LRTSN,0))#2 S $P(^(0),U,7)=LRNT,$P(^(0),U,9)=LRUID,$P(^(0),U,6)=160 D
 . . . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),$P(LRTSN,U,3),$P(LRTSN,U,2),LRIDT,LRSS,LRDFN,LRODT,,"ORR")
 . D ORR^LA7VMSG ; Update status to in process
 S:'$G(LRSAMP) LRSAMP=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)),U,2)
 I $P(LRPARAM,U,14),$P($G(^LRO(68,+LRAA,0)),U,16) S LRCI=0 F  S LRCI=$O(^LAB(60,+LRTS,9.1,LRCI)) Q:LRCI<1  I $D(^(LRCI,0)) S X=^(0),LRCNT=$S(+$P(X,U,3):+$P(X,U,3),1:1) D CAP1
 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) S LRCI=0 F  S LRCI=$O(^LAB(62,+LRSAMP,9,LRAA,1,+LRTS,1,LRCI)) Q:LRCI<1  I $D(^(LRCI,0)) S X=^(0),LRCNT=$S(+$P(X,U,3):+$P(X,U,3),1:1) D CAP1
 K LRCI,LRCWT,X,C3,C4,C0,LRCI,LRCNT Q
CAP1 S LRT=+LRTS D STUFI^LRCAPV1 K LRT I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,0)) S ^(0)="^68.14P^^"
 S C0=^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,0),C4=$P(C0,U,4)+1,$P(C0,U,3)=LRCI,$P(C0,U,4)=C4,^(0)=C0
C3 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,LRCI,0))#2 S:'$D(LRNT) LRNT=$$HTFM^XLFDT($H) S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,LRCI,0)=LRCI_U_LRCNT_"^^^^"_LRNT_"^.5"_U_DUZ(2)_U_LRAA_U_LRAA_U
 Q