- 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
