LRAPAP.m

LRAPAP ; IHS/DIR/FJE - ANATOMIC SORT BY PARENT FILE 10/25/88 20:15 ;

 ;;5.2;LR;;NOV 01, 1997

 ;

 ;;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

LRAPAP    ; IHS/DIR/FJE - ANATOMIC SORT BY PARENT FILE 10/25/88 20:15 ;

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

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

 +4        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