LRAPWE1.m

LRAPWE1 ; IHS/DIR/FJE - STUFF EM SCANNED GRIDS 10:03 ; [ 4/22/93 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

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

 F LR=0:0 S LR=$O(LR(LR)) Q:'LR  S LRX=LR(LR),A=$P(LRX,"^"),E=$P(LRX,"^",2),B=$P(LRX,"^",3) D GS,PM

 Q

GS S LRT=LRW(1),LRK=$P(LRX,"^",5),LRZ=$P(LRX,"^",7)-$P(LRX,"^",10) S:LRZ<0 LRZ=0 I LRZ D STF S X=LRZ+$P(LRX,"^",10),$P(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,LRW,0),"^",13)=X

 Q

PM S LRT=LRW(2),LRK=$P(LRX,"^",9),LRZ=$P(LRX,"^",8)-$P(LRX,"^",11) S:LRZ<0 LRZ=0 I LRZ D STF S X=LRZ+$P(LRX,"^",11),$P(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,LRW,0),"^",12)=X

 Q

 ;

STF S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^(0)="^68.04PA^^"

 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)) S ^(0)=LRT_"^50^^"_DUZ_"^"_LRK,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),^(0)=$P(X,"^",1,2)_"^"_LRT_"^"_($P(X,"^",4)+1)

 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^"

 F C=0:0 S C=$O(^LAB(60,LRT,9,C)) Q:'C  S C(3)=$P(^(C,0),"^",3) S:'C(3) C(3)=1 S A(1)=C(3)*LRZ D CAP

 S ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)="" Q

 ;

CAP I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)) S ^(0)=C_"^"_A(1)_"^0^0^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1) Q

 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0),$P(X,"^",2)=$S($P(X,"^",3):A(1),1:$P(X,"^",2)+A(1)),$P(X,"^",3)=0,$P(X,"^",6)=LRK,^(0)=X Q

 ;

EM S J=0,X="GRID EM" D X^LRUWK S LRW=LRT K LRT

 S X="EM SCAN AND PHOTO" D X^LRUWK S LRW(1)=LRT K LRT

 S X="EM PRINT/ENLARGEMENT" D X^LRUWK S LRW(2)=LRT K LRT

 Q

LRAPWE1   ; IHS/DIR/FJE - STUFF EM SCANNED GRIDS 10:03 ; [ 4/22/93 ]

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

 +2       ;

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

 +4        FOR LR=0:0

               SET LR=$ORDER(LR(LR))

               IF 'LR

                   QUIT 

               SET LRX=LR(LR)

               SET A=$PIECE(LRX,"^")

               SET E=$PIECE(LRX,"^",2)

               SET B=$PIECE(LRX,"^",3)

               DO GS

               DO PM

 +5        QUIT 

GS         SET LRT=LRW(1)

           SET LRK=$PIECE(LRX,"^",5)

           SET LRZ=$PIECE(LRX,"^",7)-$PIECE(LRX,"^",10)

           IF LRZ<0

               SET LRZ=0

           IF LRZ

               DO STF

               SET X=LRZ+$PIECE(LRX,"^",10)

               SET $PIECE(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,LRW,0),"^",13)=X

 +1        QUIT 

PM         SET LRT=LRW(2)

           SET LRK=$PIECE(LRX,"^",9)

           SET LRZ=$PIECE(LRX,"^",8)-$PIECE(LRX,"^",11)

           IF LRZ<0

               SET LRZ=0

           IF LRZ

               DO STF

               SET X=LRZ+$PIECE(LRX,"^",11)

               SET $PIECE(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,LRW,0),"^",12)=X

 +1        QUIT 

 +2       ;

STF        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))

               SET ^(0)="^68.04PA^^"

 +1        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0))

               SET ^(0)=LRT_"^50^^"_DUZ_"^"_LRK

               SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRT_"^"_($PIECE(X,"^",4)+1)

 +2        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0))

               SET ^(0)="^68.14P^^"

 +3        FOR C=0:0

               SET C=$ORDER(^LAB(60,LRT,9,C))

               IF 'C

                   QUIT 

               SET C(3)=$PIECE(^(C,0),"^",3)

               IF 'C(3)

                   SET C(3)=1

               SET A(1)=C(3)*LRZ

               DO CAP

 +4        SET ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)=""

           QUIT 

 +5       ;

CAP        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0))

               SET ^(0)=C_"^"_A(1)_"^0^0^^"_LRK_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA

               SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_C_"^"_($PIECE(X,"^",4)+1)

               QUIT 

 +1        SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)

           SET $PIECE(X,"^",2)=$SELECT($PIECE(X,"^",3):A(1),1:$PIECE(X,"^",2)+A(1))

           SET $PIECE(X,"^",3)=0

           SET $PIECE(X,"^",6)=LRK

           SET ^(0)=X

           QUIT 

 +2       ;

EM         SET J=0

           SET X="GRID EM"

           DO X^LRUWK

           SET LRW=LRT

           KILL LRT

 +1        SET X="EM SCAN AND PHOTO"

           DO X^LRUWK

           SET LRW(1)=LRT

           KILL LRT

 +2        SET X="EM PRINT/ENLARGEMENT"

           DO X^LRUWK

           SET LRW(2)=LRT

           KILL LRT

 +3        QUIT