LRWU3 ;SLC/RWF - COLLECT STARTING AND ENDING DATES FOR REPORTS ; 7/23/87 14:17 ;
;;5.2;LAB SERVICE;**153**;Sep 27, 1994
S U="^",LREND=0,LRSDT=0 S:'$D(DTIME) DTIME=999
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
S:X[U LREND=1 G A3:LREND S:X="" X="T" S %DT="E" D ^%DT G A1:Y<1 S LRSDT=Y
I '$L($G(LREDT)) D
. N X1,X2
. S X1=LRSDT,X2=-30 D C^%DTC S LREDT=$$DTF^LRAFUNC1(X)
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
S:X[U LREND=1 G A3:LREND I X="",'$D(LREDT) S LREDT=1000000 W " (LAST)" G A3
S:X="" X=LREDT S %DT="E" D ^%DT G A2:Y<1 S LREDT=Y
I LRSDT<LREDT S X=LRSDT,LRSDT=Y,LREDT=X
A3 S LRSDT=LRSDT+.5 K %DT Q
LRAN ;get first and last LRAN
S (LRFAN,LRLAN)=0
S LREND=0
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
S LRFAN=+X
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
S LRLAN=+X I LRFAN>LRLAN W !,"The last Accession number MUST be greater or equal to",!," the first Accession number" G LRAN
W3 Q
STAR ;set LRSTAR if list by date instead of accession number
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."
S:%<0 LREND=1 Q:%'=1
S %DT="AEQ",%DT("A")="Enter earliest date received at lab to list: " D ^%DT G S3:Y<0 S LRSTAR=Y
S %DT="AEQ",%DT("A")="Enter latest date received at lab to list: " D ^%DT S LAST=Y
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"
S3 K %DT Q
ADATE ;Get an accession date
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
S %DT="EP" D ^%DT G ADHELP:X["?",ADATE:Y=-1
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)
S LRAD=Y K %DT Q
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),!
G ADATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWU3 2501 printed Dec 13, 2024@02:23:17 Page 2
LRWU3 ;SLC/RWF - COLLECT STARTING AND ENDING DATES FOR REPORTS ; 7/23/87 14:17 ;
+1 ;;5.2;LAB SERVICE;**153**;Sep 27, 1994
+2 SET U="^"
SET LREND=0
SET LRSDT=0
if '$DATA(DTIME)
SET DTIME=999
A1 WRITE !,"Date to START with: TODAY//"
READ X:DTIME
if '$TEST
SET LREND=1
IF 'LREND
IF X["?"
WRITE !,"Enter the most recent date you want."
SET X="?"
SET %DT="E"
DO ^%DT
GOTO A1
+1 if X[U
SET LREND=1
if LREND
GOTO A3
if X=""
SET X="T"
SET %DT="E"
DO ^%DT
if Y<1
GOTO A1
SET LRSDT=Y
+2 IF '$LENGTH($GET(LREDT))
Begin DoDot:1
+3 NEW X1,X2
+4 SET X1=LRSDT
SET X2=-30
DO C^%DTC
SET LREDT=$$DTF^LRAFUNC1(X)
End DoDot:1
A2 WRITE !,"Date to END with: ",$SELECT($DATA(LREDT):LREDT,1:"LAST"),"//"
READ X:DTIME
if '$TEST
SET LREND=1
IF 'LREND
IF X["?"
WRITE !,"Enter the oldest date you want.",!
SET X="?"
SET %DT="E"
DO ^%DT
GOTO A2
+1 if X[U
SET LREND=1
if LREND
GOTO A3
IF X=""
IF '$DATA(LREDT)
SET LREDT=1000000
WRITE " (LAST)"
GOTO A3
+2 if X=""
SET X=LREDT
SET %DT="E"
DO ^%DT
if Y<1
GOTO A2
SET LREDT=Y
+3 IF LRSDT<LREDT
SET X=LRSDT
SET LRSDT=Y
SET LREDT=X
A3 SET LRSDT=LRSDT+.5
KILL %DT
QUIT
LRAN ;get first and last LRAN
+1 SET (LRFAN,LRLAN)=0
+2 SET LREND=0
W1 WRITE !,"First Accession number: 1//"
READ X:DTIME
if '$TEST
SET LREND=1
if X[U
SET LREND=1
if X=""
SET X=1
if LREND
GOTO W3
if +X'=X
SET X="?"
IF X["?"
WRITE !,"Enter the first Accession number to use"
GOTO W1
+1 SET LRFAN=+X
W2 WRITE !,"Last Accession number: LAST//"
READ X:DTIME
if '$TEST
SET LREND=1
if X[U
SET LREND=1
if LREND
GOTO W3
if X=""
SET X=9999999
if +X'=X
SET X="?"
IF X["?"
WRITE !,"Enter the Last Accession to use."
GOTO W2
+1 SET LRLAN=+X
IF LRFAN>LRLAN
WRITE !,"The last Accession number MUST be greater or equal to",!," the first Accession number"
GOTO LRAN
W3 QUIT
STAR ;set LRSTAR if list by date instead of accession number
+1 SET LREND=0
FOR I=0:0
KILL LRSTAR
WRITE !,"Do you wish to list by date (rather than by accession number)"
SET %=1
DO YN^DICN
if %
QUIT
WRITE !,"Answer 'Y'es or 'N'o."
+2 if %<0
SET LREND=1
if %'=1
QUIT
+3 SET %DT="AEQ"
SET %DT("A")="Enter earliest date received at lab to list: "
DO ^%DT
if Y<0
GOTO S3
SET LRSTAR=Y
+4 SET %DT="AEQ"
SET %DT("A")="Enter latest date received at lab to list: "
DO ^%DT
SET LAST=Y
+5 SET LRAD=$EXTRACT(LRSTAR,1,3)-1_"0000"
if LAST'=-1
SET LRWDTL=$EXTRACT(LAST,1,3)_"0000"
SET LAST=LAST\1+.99
if LAST=-1
SET LRWDTL=$EXTRACT(DT,1,3)_"0000"
S3 KILL %DT
QUIT
ADATE ;Get an accession date
+1 SET LREND=0
WRITE !," Accession Date: TODAY//"
READ X:DTIME
if '$TEST
SET X="^"
SET DTOUT=1
if X=""
SET X="T"
IF X[U
SET Y=-1
SET LREND=1
QUIT
+2 SET %DT="EP"
DO ^%DT
if X["?"
GOTO ADHELP
if Y=-1
GOTO ADATE
+3 IF $GET(LRAA)
IF $DATA(^LRO(68,+LRAA,0))
SET %=$PIECE(^LRO(68,+LRAA,0),U,3)
SET Y=$SELECT("D"[%:Y,%="Y":$EXTRACT(Y,1,3)_"0000","M"[%:$EXTRACT(Y,1,5)_"00","Q"[%:$EXTRACT(Y,1,3)_"0000"+(($EXTRACT(Y,4,5)-1)\3*300+100),1:Y)
+4 SET LRAD=Y
KILL %DT
QUIT
ADHELP WRITE !,"Enter the date of the accession to be used. If the accession is done",!," on a yearly basis, enter the year, such as ",$EXTRACT(DT,2,3),!
+1 GOTO ADATE
+2 QUIT
