source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRWLST12.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1LRWLST12 ;SLC/CJS/RWF/FHS - ACCESSION SETUP ; 9/9/87 15:41 ;
2 ;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
3CAP ;from LRWLST11,LRTSTJAM
4 N LRCNT,LA7V
5 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2
6 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)
7 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,0))#2 ^(0)=LRTS,$P(^(0),U,9)=+$G(LRTSORU)
8 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",+LRTS,+LRTS)) ^(+LRTS)=""
9VMSG S LA7V=""
10 I $G(LR696IEN),$D(^LRO(69.6,LR696IEN,0))#2 D
11 . S $P(^LRO(69.6,LR696IEN,0),U,10)=160,LRCNT=0
12 . 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
13 . . 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
14 . . . 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")
15 . D ORR^LA7VMSG ; Update status to in process
16 S:'$G(LRSAMP) LRSAMP=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)),U,2)
17 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
18 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
19 K LRCI,LRCWT,X,C3,C4,C0,LRCI,LRCNT Q
20CAP1 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^^"
21 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
22C3 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
23 Q
Note: See TracBrowser for help on using the repository browser.