LRWLST12 ;SLC/CJS/RWF/FHS - ACCESSION SETUP ; 9/9/87 15:41 ; [ 04/10/2003 12:54 PM ]
;;5.2T9;LR;**1004,1006,1009,1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**153**;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)
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
I '$D(LRPARAM) S LRPARAM=1_"^"_$P(^LAB(69.9,1,0),"^",2,255) ;IHS/DIR/FJE10/5/99
;--- END IHS MODIFICATIONS
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=$$CDHTFM^LRAFUNC1($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
LRWLST12 ;SLC/CJS/RWF/FHS - ACCESSION SETUP ; 9/9/87 15:41 ; [ 04/10/2003 12:54 PM ]
+1 ;;5.2T9;LR;**1004,1006,1009,1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**153**;Sep 27, 1994
CAP ;from LRWLST11,LRTSTJAM
+1 NEW LRCNT,LA7V
+2 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2
QUIT
+3 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))#2
SET ^(0)="^68.04PA"
SET $PIECE(^(0),U,3)=+LRTS
SET $PIECE(^(0),U,4)=1+$PIECE(^(0),U,4)
+4 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,0))#2
SET ^(0)=LRTS
SET $PIECE(^(0),U,9)=+$GET(LRTSORU)
+5 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",+LRTS,+LRTS))
SET ^(+LRTS)=""
VMSG SET LA7V=""
+1 IF $GET(LR696IEN)
IF $DATA(^LRO(69.6,LR696IEN,0))#2
Begin DoDot:1
+2 SET $PIECE(^LRO(69.6,LR696IEN,0),U,10)=160
SET LRCNT=0
+3 FOR
SET LRCNT=$ORDER(LROT(LRSAMP,LRSPEC,LRCNT))
IF LRCNT<1
QUIT
IF $DATA(LROT(LRSAMP,LRSPEC,LRCNT,"B",+LRTS))#2
SET LRTSN=LROT(LRSAMP,LRSPEC,LRCNT,"B",+LRTS)
Begin DoDot:2
+4 IF $DATA(^LRO(69.6,LR696IEN,2,+LRTSN,0))#2
SET $PIECE(^(0),U,7)=LRNT
SET $PIECE(^(0),U,9)=LRUID
SET $PIECE(^(0),U,6)=160
Begin DoDot:3
+5 DO SET^LA7VMSG($PIECE(LRORU3,U,4),$PIECE(LRORU3,U,2),$PIECE(LRORU3,U,5),$PIECE(LRORU3,U,3),$PIECE(LRTSN,U,3),$PIECE(LRTSN,U,2),LRIDT,LRSS,LRDFN,LRODT,,"ORR")
End DoDot:3
End DoDot:2
+6 ; Update status to in process
DO ORR^LA7VMSG
End DoDot:1
+7 IF '$GET(LRSAMP)
SET LRSAMP=+$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)),U,2)
+8 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+9 ;IHS/DIR/FJE10/5/99
IF '$DATA(LRPARAM)
SET LRPARAM=1_"^"_$PIECE(^LAB(69.9,1,0),"^",2,255)
+10 ;--- END IHS MODIFICATIONS
+11 IF $PIECE(LRPARAM,U,14)
IF $PIECE($GET(^LRO(68,+LRAA,0)),U,16)
SET LRCI=0
FOR
SET LRCI=$ORDER(^LAB(60,+LRTS,9.1,LRCI))
IF LRCI<1
QUIT
IF $DATA(^(LRCI,0))
SET X=^(0)
SET LRCNT=$SELECT(+$PIECE(X,U,3):+$PIECE(X,U,3),1:1)
DO CAP1
+12 IF $PIECE(LRPARAM,U,14)
IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
SET LRCI=0
FOR
SET LRCI=$ORDER(^LAB(62,+LRSAMP,9,LRAA,1,+LRTS,1,LRCI))
IF LRCI<1
QUIT
IF $DATA(^(LRCI,0))
SET X=^(0)
SET LRCNT=$SELECT(+$PIECE(X,U,3):+$PIECE(X,U,3),1:1)
DO CAP1
+13 KILL LRCI,LRCWT,X,C3,C4,C0,LRCI,LRCNT
QUIT
CAP1 SET LRT=+LRTS
DO STUFI^LRCAPV1
KILL LRT
IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,0))
SET ^(0)="^68.14P^^"
+1 SET C0=^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,0)
SET C4=$PIECE(C0,U,4)+1
SET $PIECE(C0,U,3)=LRCI
SET $PIECE(C0,U,4)=C4
SET ^(0)=C0
C3 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,LRCI,0))#2
IF '$DATA(LRNT)
SET LRNT=$$CDHTFM^LRAFUNC1($HOROLOG)
SET ^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
+1 QUIT
