LRAPWKA1 ;AVAMC/REG - STUFF SLIDE LABELS ;3/8/92 10:18
;;5.2;LAB SERVICE;;Sep 27, 1994
Q:$D(LRF)
F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A F B=0:0 S B=$O(^LR(LRDFN,LRSS,LRI,.1,A,B)) Q:'B S E=0 F G=1:1 S E=$O(^LR(LRDFN,LRSS,LRI,.1,A,B,E)) Q:'E D T
Q
T F LRT=0:0 S LRT=$O(^LR(LRDFN,LRSS,LRI,.1,A,B,E,1,LRT)) Q:'LRT S X=^(LRT,0),Y=$P(X,"^",2)+$P(X,"^",3),X(6)=Y-$P(X,"^",6) I X(6)>0 S $P(X,"^",6)=Y,$P(X,"^",7)=X(6),^(0)=X
Q
EN ;
S LRK(2)=0 G:LRSS'="AU" LRAPWKA1
F A=0:0 S A=$O(^LR(LRDFN,33,A)) Q:'A F B=0:0 S B=$O(^LR(LRDFN,33,A,B)) Q:'B S E=0 F G=1:1 S E=$O(^LR(LRDFN,33,A,B,E)) Q:'E D AUT
Q
AUT F LRT=0:0 S LRT=$O(^LR(LRDFN,33,A,B,E,1,LRT)) Q:'LRT S X=^(LRT,0),Y=$P(X,"^",2)+$P(X,"^",3),X(6)=Y-$P(X,"^",6) I X(6)>0 S $P(X,"^",6)=Y,$P(X,"^",7)=X(6),^(0)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPWKA1 792 printed Oct 16, 2024@18:09:28 Page 2
LRAPWKA1 ;AVAMC/REG - STUFF SLIDE LABELS ;3/8/92 10:18
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 if $DATA(LRF)
QUIT
+3 FOR A=0:0
SET A=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A))
if 'A
QUIT
FOR B=0:0
SET B=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,B))
if 'B
QUIT
SET E=0
FOR G=1:1
SET E=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,B,E))
if 'E
QUIT
DO T
+4 QUIT
T FOR LRT=0:0
SET LRT=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,B,E,1,LRT))
if 'LRT
QUIT
SET X=^(LRT,0)
SET Y=$PIECE(X,"^",2)+$PIECE(X,"^",3)
SET X(6)=Y-$PIECE(X,"^",6)
IF X(6)>0
SET $PIECE(X,"^",6)=Y
SET $PIECE(X,"^",7)=X(6)
SET ^(0)=X
+1 QUIT
EN ;
+1 SET LRK(2)=0
if LRSS'="AU"
GOTO LRAPWKA1
+2 FOR A=0:0
SET A=$ORDER(^LR(LRDFN,33,A))
if 'A
QUIT
FOR B=0:0
SET B=$ORDER(^LR(LRDFN,33,A,B))
if 'B
QUIT
SET E=0
FOR G=1:1
SET E=$ORDER(^LR(LRDFN,33,A,B,E))
if 'E
QUIT
DO AUT
+3 QUIT
AUT FOR LRT=0:0
SET LRT=$ORDER(^LR(LRDFN,33,A,B,E,1,LRT))
if 'LRT
QUIT
SET X=^(LRT,0)
SET Y=$PIECE(X,"^",2)+$PIECE(X,"^",3)
SET X(6)=Y-$PIECE(X,"^",6)
IF X(6)>0
SET $PIECE(X,"^",6)=Y
SET $PIECE(X,"^",7)=X(6)
SET ^(0)=X
+1 QUIT
