- LRCHIVE ;SLC/RWF - REMOVE OLD DATA FROM PT. FILE ;8/10/89 11:11 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- Q ;C2=NUMBER OF PT, C3=NUMBER OF DATES
- 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
- 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
- PT S PNM="unk",SSN="unk"
- Q:LRDPF<1 D DEM^LRX
- S:SSN="" SSN="unk" S:PNM="" PNM="unk" Q
- DFN ;from LRCHIV
- S LRDFN=$O(^LR(LRDFN)) G TEND:LRDFN'>0 W "."
- G NO0:$D(^LR(LRDFN,0))[0 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) I +LRDPF=2
- S C1=1 D PT
- F LRSS="CH","MI" I $D(^LR(LRDFN,LRSS,0)) D LAB
- S ^LAB(69.9,1,"LRDFN")=LRDFN G DFN
- TEND W !!,"SEARCH PASS DONE" D STAMP^LRX W !,"Total patient count: ",C2,". Specimen count: ",C3,! K LRDFN Q
- LAB S LRIDT=$O(^LR(LRDFN,LRSS,$S(LRSS="MI":LR(3),1:LR(2)))) Q:LRIDT<1 S LRIDT=LRIDT-.1
- LAB1 S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) I LRIDT<1 D UPDT^LRCHIVK Q
- IF $D(^LR(LRDFN,LRSS,LRIDT,0))[0 U IO W !,"BAD DATA ",LRDFN,LRSS,LRIDT," KILLED" K ^LR(LRDFN,LRSS,LRIDT) G LAB1
- S LRDAT=^LR(LRDFN,LRSS,LRIDT,0)
- IF LRSS="CH",'$P(LRDAT,U,3) U IO W !,"KILLED UNVERIFIED DATA ",LRDFN,LRSS,LRIDT K ^LR(LRDFN,LRSS,LRIDT) G LAB1
- 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
- I LRSS="CH",LRDPF=2,'$L($P(LRDAT,U,9)) G LAB1 ;NOT ON CUM CHART PAGE
- D MOVE
- G LAB1
- RCC ;REMOVE CONTROL CHAR.
- 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:"")
- S ^LR(LRDFN,LRSS,LRIDT,I1)=LRDAT Q
- NO0 U IO W !,"NO 0 NODE FOR ^LR(",LRDFN G DFN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCHIVE 1797 printed Jan 18, 2025@03:14:20 Page 2
- LRCHIVE ;SLC/RWF - REMOVE OLD DATA FROM PT. FILE ;8/10/89 11:11 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +2 ;C2=NUMBER OF PT, C3=NUMBER OF DATES
- QUIT
- MOVE SET LRCNT=$PIECE(^LR(LRDFN,LRSS,0),U,3,4)
- if LRSS="CH"
- SET ^LAR("Z",LRDFN,LRSS,0)="^63.999904D^"_LRCNT
- if LRSS="MI"
- SET ^LAR("Z",LRDFN,LRSS,0)="^63.999905DA^"_LRCNT
- SET %X="^LR(LRDFN,LRSS,LRIDT,"
- SET %Y="^LAR(""Z"",LRDFN,LRSS,LRIDT,"
- DO %XY^%RCR
- +1 if C1
- SET C2=C2+1
- SET C1=0
- SET ^LAR("Z",LRDFN,0)=^LR(LRDFN,0)
- SET ^LAR("Z","B",LRDFN,LRDFN)=""
- SET ^LAR("NAME",PNM,LRDFN)=""
- SET ^LAR("SSN",SSN,LRDFN)=""
- SET C3=C3+1
- QUIT
- PT SET PNM="unk"
- SET SSN="unk"
- +1 if LRDPF<1
- QUIT
- DO DEM^LRX
- +2 if SSN=""
- SET SSN="unk"
- if PNM=""
- SET PNM="unk"
- QUIT
- DFN ;from LRCHIV
- +1 SET LRDFN=$ORDER(^LR(LRDFN))
- if LRDFN'>0
- GOTO TEND
- WRITE "."
- +2 if $DATA(^LR(LRDFN,0))[0
- GOTO NO0
- SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
- SET DFN=$PIECE(^(0),U,3)
- IF +LRDPF=2
- +3 SET C1=1
- DO PT
- +4 FOR LRSS="CH","MI"
- IF $DATA(^LR(LRDFN,LRSS,0))
- DO LAB
- +5 SET ^LAB(69.9,1,"LRDFN")=LRDFN
- GOTO DFN
- TEND WRITE !!,"SEARCH PASS DONE"
- DO STAMP^LRX
- WRITE !,"Total patient count: ",C2,". Specimen count: ",C3,!
- KILL LRDFN
- QUIT
- LAB SET LRIDT=$ORDER(^LR(LRDFN,LRSS,$SELECT(LRSS="MI":LR(3),1:LR(2))))
- if LRIDT<1
- QUIT
- SET LRIDT=LRIDT-.1
- LAB1 SET LRIDT=$ORDER(^LR(LRDFN,LRSS,LRIDT))
- IF LRIDT<1
- DO UPDT^LRCHIVK
- QUIT
- +1 IF $DATA(^LR(LRDFN,LRSS,LRIDT,0))[0
- USE IO
- WRITE !,"BAD DATA ",LRDFN,LRSS,LRIDT," KILLED"
- KILL ^LR(LRDFN,LRSS,LRIDT)
- GOTO LAB1
- +2 SET LRDAT=^LR(LRDFN,LRSS,LRIDT,0)
- +3 IF LRSS="CH"
- IF '$PIECE(LRDAT,U,3)
- USE IO
- WRITE !,"KILLED UNVERIFIED DATA ",LRDFN,LRSS,LRIDT
- KILL ^LR(LRDFN,LRSS,LRIDT)
- GOTO LAB1
- +4 IF $ORDER(^LR(LRDFN,LRSS,LRIDT,0))=""
- USE IO
- WRITE !,"KILLED HEADER WITH NO DATA ",LRDFN,LRSS,LRIDT
- KILL ^LR(LRDFN,LRSS,LRIDT)
- GOTO LAB1
- +5 ;NOT ON CUM CHART PAGE
- IF LRSS="CH"
- IF LRDPF=2
- IF '$LENGTH($PIECE(LRDAT,U,9))
- GOTO LAB1
- +6 DO MOVE
- +7 GOTO LAB1
- RCC ;REMOVE CONTROL CHAR.
- +1 SET X=LRDAT
- SET LRDAT=""
- FOR I=1:1:$LENGTH(X)
- SET LRDAT=LRDAT_$SELECT($ASCII(X,I)>126:"",$ASCII(X,I)>31:$EXTRACT(X,I),1:"")
- +2 SET ^LR(LRDFN,LRSS,LRIDT,I1)=LRDAT
- QUIT
- NO0 USE IO
- WRITE !,"NO 0 NODE FOR ^LR(",LRDFN
- GOTO DFN