source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRWRKS.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1LRWRKS ;SLC/RWF - WORK SHEET ACCESSION LIST ;2/19/91 11:48 ;
2 ;;5.2;LAB SERVICE;**153,358**;Sep 27, 1994
3 K DIC S DIC="^LRO(68,",DIC(0)="AEMOQ",LREND=0 D ^DIC S LRAA=+Y,LRNAME=$P(Y,U,2) G END:LRAA<1
4 K LRSTAR,DIC D STAR^LRWU3:$P(^LRO(68,LRAA,0),U,3)="Y",PHD:'$D(LRSTAR) G END:LREND
5W G END:'$D(^LRO(68,LRAA,1,LRAD,1,0))&'$D(LRSTAR)
6 S LRUNC=0,LRTSE=-1
7 K DIC W !,"Do you want a specific test?" S %=2 D YN^DICN IF %=1 S DIC="^LAB(60,",DIC(0)="AEMOQ" D ^DIC S LRTSE=+Y
8 W !,"Do you want only incomplete entries?" S %=1 D YN^DICN S:%=2 LRUNC=1
9 W !,"Do you want a long list?" S %=2 D YN^DICN S LRSHORT=(%=2)
10 S %ZIS="Q" D ^%ZIS G END:POP
11 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^LRWRKS" S ZTSAVE("LR*")="",ZTSAVE("LAST")="" D ^%ZTLOAD G END
12 D ENT G END
13ENT U IO D URG^LRX S Y=DT D DD^LRX S LRDT0=Y,LRDC=1,LRLINE="---------------------------------------"
14 I '$D(LRSTAR) S LRAN=LRFAN-1 F LRIX=0:0 S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)),LREND=0 Q:LRAN>LRLAN!(LRAN<1) D ACC
15 I $D(LRSTAR) F A=0:0 S LRAD=$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD<1!(LRAD>LRWDTL) D AC
16 Q
17ACC D TD IF 'LREND,K1 D:LRUNC!'LRVER ENT^LRWRKS2
18 Q
19TD S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) LREND=1 Q:LREND S LRSN=+$P(^(0),U,5),LRDAT=+$P(^(0),U,4)
20 S LRVER=1,K1=0,I=0 F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<.5 S LRVER=(LRVER&$P(^(I,0),U,5)) I 'K1,LRTSE>0,+^(0)=LRTSE S K1=I
21 S K1=$S(LRTSE<0:1,1:K1) Q
22 Q
23PHD Q:LREND S LREND=0,U="^" D ADATE^LRWU Q:LREND D LRAN^LRWU3 Q
24 Q
25AC S LRTK=LRSTAR-.00001 F B=0:0 S LRTK=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK)) Q:LRTK<1!(LAST>1&(LRTK\1>LAST)) D AC1
26 Q
27AC1 S LRAN=0 F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,"E",LRTK,LRAN)) Q:LRAN<1 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D ACC
28 Q
29% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
30END W !! W:$E(IOST)="P" @IOF D ^%ZISC K ZTRTN,ZTIO,ZTDESC,ZTSAVE,%H,%ZIS,DFN,J,LRDFN,LRDOC,LREDT,LRSDT,LRCDT,LRUID
31 K %,A,B,I,K,K1,L,LRACC,LRSPEC,LRURG,SEX,SSN,X,Y,DIC,LRUNC,LRDAT,LRAA,LRAD,LRAN,LRDPF,LRSN,LRSTAR,LRSHORT,LAST,PNM,ZTSK,LRDC,LRIDT,LRLLOC,LRODNUM,LRTK,LRV,LRWDTL,POP,T
32 K LRTSTS,LRLAN,LREND,LRLINE,LRFAN,LRFI,LRIX,LRNAME,LRTSE,LRVER,VA("BID"),VA("PID")
33 Q
34EN ;
35DQ U IO S U="^" D ENT S:$D(ZTQUEUED) ZTREQ="@" G END
36ALLUNC W !,"LIST ALL UNVERIFIED TEST's for one day",! D ADATE^LRWU3 G END:LREND S %ZIS="Q" D ^%ZIS G END:POP
37 I $D(IO("Q")) K IO("Q") S ZTRTN="ALL^LRWRKS",ZTSAVE("LRAD")="" D ^%ZTLOAD G END
38ALL S U="^",LRUNC=0,LRTSE=-1,LRFAN=1,LRLAN=999999,LRSHORT=1
39 F LRAA=0:0 S LRAA=$O(^LRO(68,LRAA)) Q:LRAA'>0 S LRAD(1)=LRAD,LRDC=1 D AL2
40 S:$D(ZTQUEUED) ZTREQ="@" G END
41AL2 K LRSTAR S LAST=LRAD+.99 S LRNAME=$P(^LRO(68,LRAA,0),U,1) I $P(^(0),U,3)="Y" S LRSTAR=LRAD,LRWDTL=$E(LRAD,1,3)_"0000",LRAD=LRWDTL-10000
42 D ENT S LRAD=LRAD(1) Q
Note: See TracBrowser for help on using the repository browser.