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 ---[H[J[2J[HLRAPAP 635 printed Dec 13, 2024@02:06:51 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
