LAMIVTLW.m

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 ---LAMIVTLW   678     printed  Apr 09, 2024@20:46                                                                                                                                                                                                        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