- LRWU3 ;SLC/RWF - COLLECT STARTING AND ENDING DATES FOR REPORTS ; 7/23/87 14:17 ;
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;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
- LRWU3 ;SLC/RWF - COLLECT STARTING AND ENDING DATES FOR REPORTS ; 7/23/87 14:17 ;
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**153**;Sep 27, 1994
- +3 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
