| 1 | LRWU3 ;SLC/RWF - COLLECT STARTING AND ENDING DATES FOR REPORTS ; 7/23/87 14:17 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**153**;Sep 27, 1994
|
|---|
| 3 | S U="^",LREND=0,LRSDT=0 S:'$D(DTIME) DTIME=999
|
|---|
| 4 | A1 W !,"Date to START with: TODAY//" R X:DTIME S:'$T LREND=1 I 'LREND,X["?" W !,"Enter the most recent date you want." S X="?",%DT="E" D ^%DT G A1
|
|---|
| 5 | S:X[U LREND=1 G A3:LREND S:X="" X="T" S %DT="E" D ^%DT G A1:Y<1 S LRSDT=Y
|
|---|
| 6 | I '$L($G(LREDT)) D
|
|---|
| 7 | . N X1,X2
|
|---|
| 8 | . S X1=LRSDT,X2=-30 D C^%DTC S LREDT=$$DTF^LRAFUNC1(X)
|
|---|
| 9 | A2 W !,"Date to END with: ",$S($D(LREDT):LREDT,1:"LAST"),"//" R X:DTIME S:'$T LREND=1 I 'LREND,X["?" W !,"Enter the oldest date you want.",! S X="?",%DT="E" D ^%DT G A2
|
|---|
| 10 | S:X[U LREND=1 G A3:LREND I X="",'$D(LREDT) S LREDT=1000000 W " (LAST)" G A3
|
|---|
| 11 | S:X="" X=LREDT S %DT="E" D ^%DT G A2:Y<1 S LREDT=Y
|
|---|
| 12 | I LRSDT<LREDT S X=LRSDT,LRSDT=Y,LREDT=X
|
|---|
| 13 | A3 S LRSDT=LRSDT+.5 K %DT Q
|
|---|
| 14 | LRAN ;get first and last LRAN
|
|---|
| 15 | S (LRFAN,LRLAN)=0
|
|---|
| 16 | S LREND=0
|
|---|
| 17 | W1 W !,"First Accession number: 1//" R X:DTIME S:'$T LREND=1 S:X[U LREND=1 S:X="" X=1 G W3:LREND S:+X'=X X="?" I X["?" W !,"Enter the first Accession number to use" G W1
|
|---|
| 18 | S LRFAN=+X
|
|---|
| 19 | W2 W !,"Last Accession number: LAST//" R X:DTIME S:'$T LREND=1 S:X[U LREND=1 G W3:LREND S:X="" X=9999999 S:+X'=X X="?" I X["?" W !,"Enter the Last Accession to use." G W2
|
|---|
| 20 | S LRLAN=+X I LRFAN>LRLAN W !,"The last Accession number MUST be greater or equal to",!," the first Accession number" G LRAN
|
|---|
| 21 | W3 Q
|
|---|
| 22 | STAR ;set LRSTAR if list by date instead of accession number
|
|---|
| 23 | S LREND=0 F I=0:0 K LRSTAR W !,"Do you wish to list by date (rather than by accession number)" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o."
|
|---|
| 24 | S:%<0 LREND=1 Q:%'=1
|
|---|
| 25 | S %DT="AEQ",%DT("A")="Enter earliest date received at lab to list: " D ^%DT G S3:Y<0 S LRSTAR=Y
|
|---|
| 26 | S %DT="AEQ",%DT("A")="Enter latest date received at lab to list: " D ^%DT S LAST=Y
|
|---|
| 27 | S LRAD=$E(LRSTAR,1,3)-1_"0000" S:LAST'=-1 LRWDTL=$E(LAST,1,3)_"0000",LAST=LAST\1+.99 S:LAST=-1 LRWDTL=$E(DT,1,3)_"0000"
|
|---|
| 28 | S3 K %DT Q
|
|---|
| 29 | ADATE ;Get an accession date
|
|---|
| 30 | S LREND=0 W !," Accession Date: TODAY//" R X:DTIME S:'$T X="^",DTOUT=1 S:X="" X="T" I X[U S Y=-1,LREND=1 Q
|
|---|
| 31 | S %DT="EP" D ^%DT G ADHELP:X["?",ADATE:Y=-1
|
|---|
| 32 | I $G(LRAA),$D(^LRO(68,+LRAA,0)) S %=$P(^LRO(68,+LRAA,0),U,3),Y=$S("D"[%:Y,%="Y":$E(Y,1,3)_"0000","M"[%:$E(Y,1,5)_"00","Q"[%:$E(Y,1,3)_"0000"+(($E(Y,4,5)-1)\3*300+100),1:Y)
|
|---|
| 33 | S LRAD=Y K %DT Q
|
|---|
| 34 | ADHELP W !,"Enter the date of the accession to be used. If the accession is done",!," on a yearly basis, enter the year, such as ",$E(DT,2,3),!
|
|---|
| 35 | G ADATE
|
|---|
| 36 | Q
|
|---|
