Home Package List Routine Alphabetical List Global Alphabetical List FileMan Files List FileMan Sub-Files List Package Component Lists Package-Namespace Mapping
Routine: LRUSET

LRUSET.m

Go to the documentation of this file.

LRUSET ; IHS/DIR/FJE - RELEASE REPORTS 8/5/87 10:43 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 F A="ASPA","ACYA" F Y=0:0 S Y=$O(^LR(A,Y)) Q:Y=""  F LRAN=0:0 S LRAN=$O(^LR(A,Y,LRAN)) Q:LRAN=""  S LRDFN=$O(^(LRAN,0)),LRIDT=$O(^(LRDFN,0)),$P(^LR(LRDFN,$E(A,2,3),LRIDT,0),"^",11)=1

LRUSET    ; IHS/DIR/FJE - RELEASE REPORTS 8/5/87 10:43 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        FOR A="ASPA","ACYA"

               FOR Y=0:0

                   SET Y=$ORDER(^LR(A,Y))

                   IF Y=""

                       QUIT

                   FOR LRAN=0:0

                       SET LRAN=$ORDER(^LR(A,Y,LRAN))

                       IF LRAN=""

                           QUIT

                       SET LRDFN=$ORDER(^(LRAN,0))

                       SET LRIDT=$ORDER(^(LRDFN,0))

                       SET $PIECE(^LR(LRDFN,$EXTRACT(A,2,3),LRIDT,0),"^",11)=1

 +5        QUIT