LAMIVTLW ;DAL/HOAK VITEK ARANGER FOR LART
;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30**;Sep 27,1994
;
Q
S LRDZ1=0
F S LRDZ1=$O(LART("a3",LRDZ1)) Q:LRDZ1'>0 D
. I '$D(LART("a4",LRDZ1)) S LART("a4",LRDZ1)=LART("a3",LRDZ1)
NA ;
;QUIT
Q:'$G(LRLL)
S LRX09="^LAH(LRLL,1)"
F S LRX09=$Q(@LRX09) Q:LRX09'[LRLL D
. I @LRX09["NA" S @LRX09=$P(@LRX09,"NA")_$P(@LRX09,"NA",2)
. ;I $P(@LRX09,U,2)="NA" S $P(@LRX09,U,2)=$P(@LRX09,U)
Q
;
NA1 ;
;
QUIT
Q:'$D(^LR(LRDFN,LRSUB,LRIDT))
S LRX09="^LR(LRDFN,LRSUB,LRIDT)"
D UPDATE
QUIT
;
UPDATE ;
;
F S LRX09=$Q(@LRX09) Q:LRX09'[LRLL D
. I $P(@LRX09,U)="NA" S $P(@LRX09,U)=$P(@LRX09,U,2)
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIVTLW 678 printed Dec 13, 2024@01:43:37 Page 2
LAMIVTLW ;DAL/HOAK VITEK ARANGER FOR LART
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30**;Sep 27,1994
+2 ;
+3 QUIT
+4 SET LRDZ1=0
+5 FOR
SET LRDZ1=$ORDER(LART("a3",LRDZ1))
if LRDZ1'>0
QUIT
Begin DoDot:1
+6 IF '$DATA(LART("a4",LRDZ1))
SET LART("a4",LRDZ1)=LART("a3",LRDZ1)
End DoDot:1
NA ;
+1 ;QUIT
+2 if '$GET(LRLL)
QUIT
+3 SET LRX09="^LAH(LRLL,1)"
+4 FOR
SET LRX09=$QUERY(@LRX09)
if LRX09'[LRLL
QUIT
Begin DoDot:1
+5 IF @LRX09["NA"
SET @LRX09=$PIECE(@LRX09,"NA")_$PIECE(@LRX09,"NA",2)
+6 ;I $P(@LRX09,U,2)="NA" S $P(@LRX09,U,2)=$P(@LRX09,U)
End DoDot:1
+7 QUIT
+8 ;
NA1 ;
+1 ;
+2 QUIT
+3 if '$DATA(^LR(LRDFN,LRSUB,LRIDT))
QUIT
+4 SET LRX09="^LR(LRDFN,LRSUB,LRIDT)"
+5 DO UPDATE
+6 QUIT
+7 ;
UPDATE ;
+1 ;
+2 FOR
SET LRX09=$QUERY(@LRX09)
if LRX09'[LRLL
QUIT
Begin DoDot:1
+3 IF $PIECE(@LRX09,U)="NA"
SET $PIECE(@LRX09,U)=$PIECE(@LRX09,U,2)
End DoDot:1
+4 QUIT
