- 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 Feb 18, 2025@23:32:44 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