- LRAC2A ;SLC/DCM - CUMULATIVE CONT. ; 25 Oct 88 2:56 PM ;
- ;;5.2;LAB SERVICE;**225**;Sep 27, 1994
- MISC S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0)) Q:LRTST=""
- I "IN"[$P(^LAB(60,LRTST,0),U,3) K ^LRO(68,"AC",LRDFN,LRIDT,LRSUB) Q
- S LRTOP=LRSPM I '$D(^LAC(LRXLR,LRDFN,"MISC",0)) S ^(0)="^64.702^1^1"
- I '$D(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,0)) S ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN,LRZO="^LAC("""_LRXLR_""","_LRDFN_",""MISC"",1,1,",LRZ1="64.707D",LRZ3=LRIIDT D Z^LRWU
- F I=0:0 S I=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,1,I)) Q:'I I $D(^(I,0)),$P(^(0),"^",5)=LRSUB K ^(0)
- A I $D(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,1,LRTNN)) S LRTNN=LRTNN+1 G A
- S ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,1,LRTNN,0)=LRTSTVAL_U_LRSPM_U_LRTST_U_X1_U_LRSUB,LRZO="^LAC("""_LRXLR_""","_LRDFN_",""MISC"",1,1,"_LRIIDT_",1,",LRZ1=64.708,LRZ3=LRTNN D Z^LRWU
- I '$L(LX1)!(LX2&(LX1_":"_LX2'="MISC:1")),'$D(^LAC("LGOT",LRDFN,"MISC")) S ^("MISC")="",^LAC("LRAC",LRDFN,"MISC",1,.5)=1
- S:'LRRE ^LRO(68,"AC",LRDFN,LRIDT,LRSUB)="MISC^1"
- K ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX")
- I $O(^LR(LRDFN,"CH",LRIDT,1,0)) S ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX",0)="^^1^1^"_LRIIDT S L=0 F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:'L S ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
- S:+LRIPG<0 ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX",.1,0)="ATTENTION: This data has been modified from previously reported results!!!" S LRTNN=LRTNN+1 K LRLN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAC2A 1434 printed Feb 18, 2025@23:32 Page 2
- LRAC2A ;SLC/DCM - CUMULATIVE CONT. ; 25 Oct 88 2:56 PM ;
- +1 ;;5.2;LAB SERVICE;**225**;Sep 27, 1994
- MISC SET LRTST=$ORDER(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
- if LRTST=""
- QUIT
- +1 IF "IN"[$PIECE(^LAB(60,LRTST,0),U,3)
- KILL ^LRO(68,"AC",LRDFN,LRIDT,LRSUB)
- QUIT
- +2 SET LRTOP=LRSPM
- IF '$DATA(^LAC(LRXLR,LRDFN,"MISC",0))
- SET ^(0)="^64.702^1^1"
- +3 IF '$DATA(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,0))
- SET ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN
- SET LRZO="^LAC("""_LRXLR_""","_LRDFN_",""MISC"",1,1,"
- SET LRZ1="64.707D"
- SET LRZ3=LRIIDT
- DO Z^LRWU
- +4 FOR I=0:0
- SET I=$ORDER(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,1,I))
- if 'I
- QUIT
- IF $DATA(^(I,0))
- IF $PIECE(^(0),"^",5)=LRSUB
- KILL ^(0)
- A IF $DATA(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,1,LRTNN))
- SET LRTNN=LRTNN+1
- GOTO A
- +1 SET ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,1,LRTNN,0)=LRTSTVAL_U_LRSPM_U_LRTST_U_X1_U_LRSUB
- SET LRZO="^LAC("""_LRXLR_""","_LRDFN_",""MISC"",1,1,"_LRIIDT_",1,"
- SET LRZ1=64.708
- SET LRZ3=LRTNN
- DO Z^LRWU
- +2 IF '$LENGTH(LX1)!(LX2&(LX1_":"_LX2'="MISC:1"))
- IF '$DATA(^LAC("LGOT",LRDFN,"MISC"))
- SET ^("MISC")=""
- SET ^LAC("LRAC",LRDFN,"MISC",1,.5)=1
- +3 if 'LRRE
- SET ^LRO(68,"AC",LRDFN,LRIDT,LRSUB)="MISC^1"
- +4 KILL ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX")
- +5 IF $ORDER(^LR(LRDFN,"CH",LRIDT,1,0))
- SET ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX",0)="^^1^1^"_LRIIDT
- SET L=0
- FOR
- SET L=$ORDER(^LR(LRDFN,"CH",LRIDT,1,L))
- if 'L
- QUIT
- SET ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
- +6 if +LRIPG<0
- SET ^LAC(LRXLR,LRDFN,"MISC",1,1,LRIIDT,"TX",.1,0)="ATTENTION: This data has been modified from previously reported results!!!"
- SET LRTNN=LRTNN+1
- KILL LRLN
- +7 QUIT