- 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 Apr 23, 2025@18:22:41 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
