| 1 | LRAC2 ;SLC/DCM - CUMULATIVE CONT. ; 12/12/88  10:16 ; | 
|---|
| 2 | ;;5.2;LAB SERVICE;**225**;Sep 27, 1994 | 
|---|
| 3 | TST1 Q:LRSPM'=LRSPM1 | 
|---|
| 4 | I $L(LX1),LX2,$D(^LAC(LRXLR,LRDFN,1,LX1,1,LX2,1,LRIIDT,1,LRTSTS)),LRMH_":"_LRSH=(LX1_":"_LX2) S LRNON=1 Q | 
|---|
| 5 | SBSET S LRMHN=$P(^LAB(64.5,1,1,LRMH,0),U,1),LRTF=^(1,LRSH,0),$P(LRTF,U,4)=$P(LRTF,U,3),$P(LRTF,U,3)=$P(^(1,0),U,4),LRNON=1,LRIIDT=LRVIDT | 
|---|
| 6 | I '$D(^LAC(LRXLR,LRDFN,1,LRMH,0)) S ^(0)=LRMHN,LRZO="^LAC("""_LRXLR_""","_LRDFN_",1,",LRZ1=64.701,LRZ3=LRMH D Z^LRWU | 
|---|
| 7 | I '$D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,0))!($D(^(0))=10) S ^(0)=LRTF_U,LRZO="^LAC("""_LRXLR_""","_LRDFN_",1,"_LRMH_",1,",LRZ1=64.703,LRZ3=LRSH D Z^LRWU | 
|---|
| 8 | I '$D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRIIDT,0)) S ^(0)=LRVIDT_U_LRTLOC_U_LRVDT_U_LRAN_U_LRIDT,LRZO="^LAC("""_LRXLR_""","_LRDFN_",1,"_LRMH_",1,"_LRSH_",1,",LRZ1="64.704D",LRZ3=LRIIDT D Z^LRWU | 
|---|
| 9 | LRTSTVAL S ^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRIIDT,1,LRTSTS,0)=LRTSTVAL_U_X1_U_LRSUB,LRZO="^LAC("""_LRXLR_""","_LRDFN_",1,"_LRMH_",1,"_LRSH_",1,"_LRIIDT_",1,",LRZ1=64.705,LRZ3=LRTSTS D Z^LRWU | 
|---|
| 10 | I $D(^LR(LRDFN,"CH",LRIDT,1,0)) D TEXT | 
|---|
| 11 | I '$L(LX1)!(LX2&(LX1_":"_LX2'=(LRMH_":"_LRSH))),'$D(^LAC("LGOT",LRDFN,LRMH)) S ^(LRMH)="",^LAC("LRAC",LRDFN,1,LRMH,.5)=1 | 
|---|
| 12 | S:'LRRE ^LRO(68,"AC",LRDFN,LRIDT,LRSUB)=LRMH_"^"_LRSH | 
|---|
| 13 | Q | 
|---|
| 14 | SUB1 I '$D(^LR(LRDFN,"CH",LRIDT,LRSUB)) K ^LRO(68,"AC",LRDFN,LRIDT,LRSUB) Q | 
|---|
| 15 | S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";1",0)) I LRTST="" K ^LRO(68,"AC",LRDFN,LRIDT,LRSUB) Q | 
|---|
| 16 | S LX2=$P(LX1,"^",2),LX1=$P(LX1,"^") | 
|---|
| 17 | SUB2 ;from LRACM2 | 
|---|
| 18 | S LRTSTVAL=$P(^LR(LRDFN,"CH",LRIDT,LRSUB),U,1),X1=$P(^(LRSUB),U,2) | 
|---|
| 19 | I "IN"[$P(^LAB(60,LRTST,0),U,3) K ^LRO(68,"AC",LRDFN,LRIDT,LRSUB) Q | 
|---|
| 20 | G S LRNOFL="" | 
|---|
| 21 | I '$D(^LAB(64.5,"AC",LRSUB)),LX1'="MISC" D MISC^LRAC2A Q | 
|---|
| 22 | K LRNON | 
|---|
| 23 | S LRMH=0 F  S LRMH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH)) Q:'LRMH  S LRSH=0 F  S LRSH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH)) Q:'LRSH  S LRTSTS=0 F  S LRTSTS=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS)) Q:'LRTSTS  S LRSPM1=^(LRTSTS) D TST1 | 
|---|
| 24 | I '$D(LRNON),LX1'="MISC" D MISC^LRAC2A | 
|---|
| 25 | K LX1,LX2 Q | 
|---|
| 26 | LRIDT ;from LRAC1 | 
|---|
| 27 | I $D(^LR(LRDFN,"CH",LRIDT,0))[0 K ^LRO(68,"AC",LRDFN,LRIDT) Q | 
|---|
| 28 | LRSPM S X=^LR(LRDFN,"CH",LRIDT,0),LRIIDT=$P(X,U,1),LRTNN=1,LRVIDT=LRIIDT | 
|---|
| 29 | OD S LRSPM=$P(X,U,5),LRIPG=$P(X,U,9),LRTLOC=$E($P(X,U,11),1,7),LRVDT=$P(X,U,3),LRAN=$P(X,U,6) | 
|---|
| 30 | Q:'$L(LRVDT)  S LRSUB=1 F  S LRSUB=$O(^LRO(68,"AC",LRDFN,LRIDT,LRSUB)) Q:LRSUB<1  S LX1=^(LRSUB) D SUB1 | 
|---|
| 31 | Q | 
|---|
| 32 | TEXT S LRYESCOM=0 K ^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRIIDT,"TX") | 
|---|
| 33 | S M=0 F  S M=$O(^LR(LRDFN,"CH",LRIDT,1,M)) Q:'M!(LRYESCOM)  F N=1:1:$L(^LR(LRDFN,"CH",LRIDT,1,M,0)) Q:LRYESCOM  S:$E(^(0),N)'[$C(32) LRYESCOM=1 | 
|---|
| 34 | Q:'LRYESCOM | 
|---|
| 35 | S ^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRIIDT,"TX",0)="^^1^1^"_LRIIDT | 
|---|
| 36 | S L=0 F  S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:'L  S ^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRIIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0) | 
|---|
| 37 | I +LRIPG<0 S ^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRIIDT,"TX",.1,0)="ATTENTION: This data has been modified from previously reported results!!! " | 
|---|
| 38 | Q | 
|---|
| 39 | LRCALE ;from LRAC1, LRACM2, LRACM3 | 
|---|
| 40 | S A7=0 F  S A7=$O(^LAB(64.5,1,1,A7)) Q:A7<1  S B3=0 F  S B3=$O(^LAB(64.5,1,1,A7,1,B3)) Q:B3<1  S:$P(^LAB(64.5,1,1,A7,1,B3,0),U,4) LRCALE(A7,B3)=1 | 
|---|
| 41 | K A7,B3 Q | 
|---|