| [613] | 1 | LRLAM ;SLC/CJS - STUFF AMIS DATA INTO LAM GLOBAL ;2/5/91 14:18 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | ; CALL WITH LRDFN AND LRIDT AND LRLLOC
|
|---|
| 4 | Q:'$D(^LR(LRDFN,"CH",LRIDT,0)) S Y=^(0),LRSPEC=$P(Y,U,5),LRMETH=$P(Y,U,8),U="^"
|
|---|
| 5 | S N=$O(^LAB(62.4,"D",LRMETH,0)),LRSUF=$S($D(^LAB(62.4,N,6)):+(6),1:".00")
|
|---|
| 6 | S LRSITE=$S($D(DUZ(2)):DUZ(2),1:0) Q:'LRSITE
|
|---|
| 7 | S LRSB=0 F S LRSB=$O(^LR(LRDFN,"CH",LRIDT,LRSB)) Q:LRSB<1 D PIECE
|
|---|
| 8 | END K LRCODE,LRSUF
|
|---|
| 9 | Q
|
|---|
| 10 | 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
|
|---|
| 11 | Q
|
|---|
| 12 | CHECK I $D(^LAM(LRLN,1,LRSITE,1,DT,1,N,0)) S N=N+1 G CHECK
|
|---|
| 13 | 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
|
|---|
| 14 | Q
|
|---|
| 15 | 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
|
|---|
| 16 | 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
|
|---|
| 17 | I '$D(^LAM(LRLN,1,LRSITE,1,0)) S ^LAM(LRLN,1,LRSITE,1,0)="",^(DT,0)=DT
|
|---|
| 18 | S N=$P(^LAM(LRLN,1,LRSITE,1,0),U,4),^(0)="^64.02DA^"_DT_U_(N+1)
|
|---|
| 19 | I '$D(^LAM(LRLN,1,LRSITE,1,DT,1,0)) S ^LAM(LRLN,1,LRSITE,1,DT,1,0)="^64.03A^"
|
|---|
| 20 | 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
|
|---|
| 21 | S $P(^LAM(LRLN,1,LRSITE,1,DT,1,N,0),U,1)=1+^LAM(LRLN,1,LRSITE,1,DT,1,N,0)
|
|---|
| 22 | Q
|
|---|
