- 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
