LRAPAP.m

LRAPAP ;AVAMC/REG - ANATOMIC SORT BY PARENT FILE ; 10/25/88  20:15 ;

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

 W !!?15,LRAA(1)," Entries Alphabetically by Patient",!!

A R !!,"Start with letter: ",X:DTIME G:X=""!(X[U) END D CK G:'$D(X) A S A(1)=X

B R !!,"End   with letter: ",X:DTIME G:X=""!(X[U) END D CK G:'$D(X) B S A(2)=X

 S ZTRTN="QUE^LRAPAP" D BEG^LRUTL G:POP!($D(ZTSK)) END

QUE U IO S LRQ=0

 F Q=0:0 S Q=$O(^DIC("AC","LR",Q)) Q:'Q  S Q(1)=^DIC(Q,0),Q(2)=^(0,"GL") S LRNM=$C(A(1)) ; unfinished D ^LRAPAP1

 D END^LRUTL,END Q

CK S X=$A(X) I X<65!(X>90) W $C(7),!!,"Letter must be UPPER CASE (A to Z)" K X Q

 Q

 ;

END D V^LRU Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRAPAP   635     printed  Apr 09, 2024@21:11:23                                                                                                                                                                                                       Page 2

LRAPAP    ;AVAMC/REG - ANATOMIC SORT BY PARENT FILE ; 10/25/88  20:15 ;

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

 +2        WRITE !!?15,LRAA(1)," Entries Alphabetically by Patient",!!

A          READ !!,"Start with letter: ",X:DTIME

           if X=""!(X[U)

               GOTO END

           DO CK

           if '$DATA(X)

               GOTO A

           SET A(1)=X

B          READ !!,"End   with letter: ",X:DTIME

           if X=""!(X[U)

               GOTO END

           DO CK

           if '$DATA(X)

               GOTO B

           SET A(2)=X

 +1        SET ZTRTN="QUE^LRAPAP"

           DO BEG^LRUTL

           if POP!($DATA(ZTSK))

               GOTO END

QUE        USE IO

           SET LRQ=0

 +1       ; unfinished D ^LRAPAP1

           FOR Q=0:0

               SET Q=$ORDER(^DIC("AC","LR",Q))

               if 'Q

                   QUIT 

               SET Q(1)=^DIC(Q,0)

               SET Q(2)=^(0,"GL")

               SET LRNM=$CHAR(A(1))

 +2        DO END^LRUTL

           DO END

           QUIT 

CK         SET X=$ASCII(X)

           IF X<65!(X>90)

               WRITE $CHAR(7),!!,"Letter must be UPPER CASE (A to Z)"

               KILL X

               QUIT 

 +1        QUIT 

 +2       ;

END        DO V^LRU

           QUIT