LRAPWKA1.m

LRAPWKA1 ; IHS/DIR/FJE - STUFF SLIDE LABELS 10:18 ; [ 3/8/92 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

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

LRAPWKA1  ; IHS/DIR/FJE - STUFF SLIDE LABELS 10:18 ; [ 3/8/92 ]

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

 +2       ;

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

 +4        IF $DATA(LRF)

               QUIT 

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

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