source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLAM.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1LRLAM ;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
8END K LRCODE,LRSUF
9 Q
10PIECE 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
12CHECK 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
15COUNT 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
Note: See TracBrowser for help on using the repository browser.