| 1 | LRCHIVE ;SLC/RWF - REMOVE OLD DATA FROM PT. FILE ;8/10/89 11:11 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | Q ;C2=NUMBER OF PT, C3=NUMBER OF DATES
|
|---|
| 4 | MOVE S LRCNT=$P(^LR(LRDFN,LRSS,0),U,3,4) S:LRSS="CH" ^LAR("Z",LRDFN,LRSS,0)="^63.999904D^"_LRCNT S:LRSS="MI" ^LAR("Z",LRDFN,LRSS,0)="^63.999905DA^"_LRCNT S %X="^LR(LRDFN,LRSS,LRIDT,",%Y="^LAR(""Z"",LRDFN,LRSS,LRIDT," D %XY^%RCR
|
|---|
| 5 | S:C1 C2=C2+1,C1=0,^LAR("Z",LRDFN,0)=^LR(LRDFN,0),^LAR("Z","B",LRDFN,LRDFN)="",^LAR("NAME",PNM,LRDFN)="",^LAR("SSN",SSN,LRDFN)="" S C3=C3+1 Q
|
|---|
| 6 | PT S PNM="unk",SSN="unk"
|
|---|
| 7 | Q:LRDPF<1 D DEM^LRX
|
|---|
| 8 | S:SSN="" SSN="unk" S:PNM="" PNM="unk" Q
|
|---|
| 9 | DFN ;from LRCHIV
|
|---|
| 10 | S LRDFN=$O(^LR(LRDFN)) G TEND:LRDFN'>0 W "."
|
|---|
| 11 | G NO0:$D(^LR(LRDFN,0))[0 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) I +LRDPF=2
|
|---|
| 12 | S C1=1 D PT
|
|---|
| 13 | F LRSS="CH","MI" I $D(^LR(LRDFN,LRSS,0)) D LAB
|
|---|
| 14 | S ^LAB(69.9,1,"LRDFN")=LRDFN G DFN
|
|---|
| 15 | TEND W !!,"SEARCH PASS DONE" D STAMP^LRX W !,"Total patient count: ",C2,". Specimen count: ",C3,! K LRDFN Q
|
|---|
| 16 | LAB S LRIDT=$O(^LR(LRDFN,LRSS,$S(LRSS="MI":LR(3),1:LR(2)))) Q:LRIDT<1 S LRIDT=LRIDT-.1
|
|---|
| 17 | LAB1 S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) I LRIDT<1 D UPDT^LRCHIVK Q
|
|---|
| 18 | IF $D(^LR(LRDFN,LRSS,LRIDT,0))[0 U IO W !,"BAD DATA ",LRDFN,LRSS,LRIDT," KILLED" K ^LR(LRDFN,LRSS,LRIDT) G LAB1
|
|---|
| 19 | S LRDAT=^LR(LRDFN,LRSS,LRIDT,0)
|
|---|
| 20 | IF LRSS="CH",'$P(LRDAT,U,3) U IO W !,"KILLED UNVERIFIED DATA ",LRDFN,LRSS,LRIDT K ^LR(LRDFN,LRSS,LRIDT) G LAB1
|
|---|
| 21 | IF $O(^LR(LRDFN,LRSS,LRIDT,0))="" U IO W !,"KILLED HEADER WITH NO DATA ",LRDFN,LRSS,LRIDT K ^LR(LRDFN,LRSS,LRIDT) G LAB1
|
|---|
| 22 | I LRSS="CH",LRDPF=2,'$L($P(LRDAT,U,9)) G LAB1 ;NOT ON CUM CHART PAGE
|
|---|
| 23 | D MOVE
|
|---|
| 24 | G LAB1
|
|---|
| 25 | RCC ;REMOVE CONTROL CHAR.
|
|---|
| 26 | S X=LRDAT,LRDAT="" F I=1:1:$L(X) S LRDAT=LRDAT_$S($A(X,I)>126:"",$A(X,I)>31:$E(X,I),1:"")
|
|---|
| 27 | S ^LR(LRDFN,LRSS,LRIDT,I1)=LRDAT Q
|
|---|
| 28 | NO0 U IO W !,"NO 0 NODE FOR ^LR(",LRDFN G DFN
|
|---|
