LRLAM ;SLC/CJS - STUFF AMIS DATA INTO LAM GLOBAL ;2/5/91  14:18 ;
 ;;5.2;LAB SERVICE;;Sep 27, 1994
 ; CALL WITH LRDFN AND LRIDT AND LRLLOC
 Q:'$D(^LR(LRDFN,"CH",LRIDT,0))  S Y=^(0),LRSPEC=$P(Y,U,5),LRMETH=$P(Y,U,8),U="^"
 S N=$O(^LAB(62.4,"D",LRMETH,0)),LRSUF=$S($D(^LAB(62.4,N,6)):+(6),1:".00")
 S LRSITE=$S($D(DUZ(2)):DUZ(2),1:0) Q:'LRSITE
 S LRSB=0 F  S LRSB=$O(^LR(LRDFN,"CH",LRIDT,LRSB)) Q:LRSB<1  D PIECE
END K LRCODE,LRSUF
 Q
PIECE F LRSSP=1:1:99 Q:'$L($P(^LR(LRDFN,"CH",LRIDT,LRSB),U,LRSSP,99))  I $L($P(^(LRSB),U,LRSSP)) D COUNT
 Q
CHECK I $D(^LAM(LRLN,1,LRSITE,1,DT,1,N,0)) S N=N+1 G CHECK
 S ^LAM(LRLN,1,LRSITE,1,DT,1,"B",LRLLOC,N)="",C=$P(^LAM(LRLN,1,LRSITE,1,DT,1,0),U,4),^(0)="^64.03A^"_C_U_C
 Q
COUNT S LRTEST=$O(^LAB(60,"C",("CH;"_LRSB_";"_LRSSP),0)),LRCODE=$S($D(^LAB(60,LRTEST,1,LRSPEC,2,1,0)):^(0),1:-1),LRCODE=$S($D(^LAM(LRCODE,0)):$P(^(0),".",1),1:"80000")_LRSUF
 S LRLN=$O(^LAM("C",LRCODE,0)) I '$D(^LAM(LRLN,1,0)) S ^LAM(LRLN,1,0)="^64.01^1^1",^(LRSITE,0)=LRSITE
 I '$D(^LAM(LRLN,1,LRSITE,1,0)) S ^LAM(LRLN,1,LRSITE,1,0)="",^(DT,0)=DT
 S N=$P(^LAM(LRLN,1,LRSITE,1,0),U,4),^(0)="^64.02DA^"_DT_U_(N+1)
 I '$D(^LAM(LRLN,1,LRSITE,1,DT,1,0)) S ^LAM(LRLN,1,LRSITE,1,DT,1,0)="^64.03A^"
 S N=$O(^LAM(LRLN,1,LRSITE,1,DT,1,"B",LRLLOC,0)) I N<1 S N=1+$P(^LAM(LRLN,1,LRSITE,1,DT,1,0),U,3) D CHECK
 S $P(^LAM(LRLN,1,LRSITE,1,DT,1,N,0),U,1)=1+^LAM(LRLN,1,LRSITE,1,DT,1,N,0)
 Q