| 1 | LRFLAG ;SLC/RWF - SEARCH ^LRO(68.2,INST,8, FOR FLAGED SAMP ;2/5/91 13:16 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | D FLAG,END Q
|
|---|
| 4 | FLAG W !!,"PROCESS FLAGGED SPECIMENS",!
|
|---|
| 5 | D INST Q:LRLL<1
|
|---|
| 6 | S %H=$H-60,X=DUZ D DUZ^LRX,YMD^LRX S LRTM60=9999999-X
|
|---|
| 7 | S LRSQ=0 F S LRSQ=$O(^LRO(68.2,LRLL,8,LRSQ)) Q:LRSQ<1 D VER
|
|---|
| 8 | W !!,$C(7),"Do you want to clear the FLAG Specimen List" S %=1 D YN^DICN I %=1 K ^LRO(68.2,LRLL,8)
|
|---|
| 9 | W:%=1 !!,"DONE" Q
|
|---|
| 10 | VER ;
|
|---|
| 11 | S X=$S($D(^LAH(LRLL,1,LRSQ,0)):^(0),1:""),LRAD=+$P(X,U,4),LRAA=+$P(X,U,3),LRAN=+$P(X,U,5) I X="" Q ;W "DON'T KNOW WHO'S DATA THIS IS" Q
|
|---|
| 12 | S LREND=0,LRTSE=-1 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) Q ;W " CAN'T FIND THE ACCESSION" Q
|
|---|
| 13 | S LRPDT=LRAD,X=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)):^(0),1:"") Q:X="" S LRDFN=+X,LRCEN=0,LRIDT=9999999-^(3),LRODT=$P(X,U,4),LRSN=$P(X,U,5)
|
|---|
| 14 | S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3) D PT^LRX W !,PNM,?30,SSN W:LRCEN !,"ORDER #: ",LRCEN
|
|---|
| 15 | K LRVTS F I6=1:0 S I6=$O(^LAH(LRLL,1,LRSQ,I6)) Q:I6<1 I ^(I6)]"",+^(I6)'=^(I6) S LRVTS(I6)=""
|
|---|
| 16 | W !,"Auto Sequence #:",LRSQ," Accession #:",LRAN
|
|---|
| 17 | I '$D(LRVTS) W !,"DIDN'T FIND ANY TESTS THAT NEED EDITING" Q
|
|---|
| 18 | D VER^LRVR1
|
|---|
| 19 | Q
|
|---|
| 20 | INST S LRSS="CH",LRPER=0,LRLL=0 D ADATE^LRWU Q:LRAD<1
|
|---|
| 21 | S U="^",DIC="^LRO(68.2,",DIC(0)="AEMQ" D ^DIC S LRLL=+Y Q:Y<1
|
|---|
| 22 | S LRPROF=$O(^LRO(68.2,LRLL,10,0)) I LRPROF<1 W !,"No profile defined." Q
|
|---|
| 23 | S B=$O(^LRO(68.2,LRLL,10,LRPROF))
|
|---|
| 24 | I B>0 S DIC="^LRO(68.2,"_LRLL_",10," D ^DIC Q:Y<1 S LRPROF=+Y
|
|---|
| 25 | S LRAA=$P(^LRO(68.2,LRLL,10,LRPROF,0),U,2),LRPANEL=$P(^(0),U,1)
|
|---|
| 26 | D EXPAND^LRVR
|
|---|
| 27 | F I=0:0 S I=$O(LRORD(I)) Q:I'>0 S X=LRORD(I),X=$P(^LAB(60,+X,0),U,5),LRORD(I)=$P(X,";",2)
|
|---|
| 28 | Q
|
|---|
| 29 | CLEAR D INST Q:LRLL<1
|
|---|
| 30 | K ^LRO(68.2,LRLL,8) W !,"DONE" Q
|
|---|
| 31 | END K LRAA,LRACD,LRAD,LRAN,LRAOD,LRCDT,LRCW,LRDAT,LRDEL,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDIT,LREXEC,LRFFLG,LRFP,LRGVP,LRIDT,LRINI,LRIOZERO,LRLCT,LRLDT,LRLK,LRLL,LRLLOC,LRMETH,LRMK,LRNG,LRNG2,LRNG3,LRNG4,LRNG5,LRNT,LRNTN,LRNX
|
|---|
| 32 | K I6,LRODT,LROUTINE,LRPANEL,LRPDT,LRPER,LRPLOC,LRPROF,LRSAMP,LRSN,LRSPEC,LRSQ,LRSS,LRSSQ,LRSUB,LRTEC,LRTM60,LRTN,LRTRAY,LRTRCP,LRTS,LRTSE,LRTX,LRUSI,LRVF,LRVOL,LRVRM,LRXD,LRXDH,LRXDP,N,N2,PNM,SEX,SSN,T,T1,X1,X2,X5,X6,X7,X9,Z1,Z2
|
|---|
| 33 | Q
|
|---|
