source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAR06.m@ 636

LRAR06 ;DALLAS/HOAK CUME ARCHIVE INITIATIVE part of 00 ; 12/12/96  10:16 ;
 ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
INIT ;
RESTART ;
 W !,"Search not complete." L +^LAR:1
 I '$T W !,"Searching in progress, please wait for it to finish." G QUIT
 L -^LAR
 W !,"Do you want to restart the search"
 S %=1 D YN^DICN
 I %'=1 W:%=0 !,"Continue where the last search stopped." G RESTART:%=0,QUIT
 ;
 D DEV^LRAR01
 G QUIT:POP S LRDFN=$S($D(^LAB(69.9,1,"LRDFN")):^("LRDFN"),1:0)
 D STEPOUT^LRARCHIV QUIT
TAPE ;
 S DA=0,DIC="^LAB(69.9,1,6,"
 S DIC("A")="Please enter a name for the archive session: "
 S DIC(0)="AEMQL"
 S DLAYGO=69 D ^DIC
 K DLAYGO Q:Y<1
 S LRDA9=+Y
 I '$P(Y,U,3) W !,"You must create a NEW name for this ARCHIVE." G TAPE
DT ;
 S OK=1
SET S DIR(0)="S^1:CH Subcript only;2:Micro Only;3:Both CH and Micro"
 S DIR("??")="Enter 1 for CH subscripted. Micro will be with next patch"
 S DIR("?")="Please enter a number 1"
 S DIR("A")="What lab section do you wish to Search"
 S DIR("B")="1"
 D ^DIR
 I $D(DTOUT)!($D(DUOUT)) S OK=0 S DA=-1
 Q:'OK
 ;S LRWHICH=$S(Y=1:"CH",Y=2:"MI",1:"BOTH") ;--NEXT PATCH
 S LRWHICH="CH"
 ;
 K DIR
 ;
 S DIR(0)="D",DIR("A")="Archive Start DATE: "
 S DIR("?")="Enter a date in the past where I should begin looking."
 S DIR("B")="T-90"
 D ^DIR
 I $D(DTOUT)!($D(DUOUT)) S OK=0 S DA=-1
 S LR(1)=+Y
 Q:'OK
 S DA=LRDA9
 Q:'$G(DA)
 S P1=DA,DIE=DIC,DR="1;2///N;4///"_LR(1)
 D ^DIE
 K DIC
 ;QUIT
 ;
 K DIR
 ;
TIME ;
 ;--> Maximize user interaction.
 S OK=1
 I '$G(LR(1)) S LR(1)=DT
 S DIR(0)="S^1:Number of days;2:Date Range;3:By the month;4:Quarterly;5:By the year"
 S DIR("?")="Enter 1 for days to archive ie 1,7,30,60,90 etc"
 S DIR("?",1)="Enter 2 for Patients results between a date range."
 S DIR("?",2)="Enter 3 for a specific month and year...11/97"
 S DIR("?",3)="Enter 4 ... 1/97 for Jan-Feb-Mar of 1997 or 2/97 for Apr-May-June of 1997 etc"
 S DIR("?",4)="Enter 5 year 1996 gets you all of 1996"
 S DIR("B")="1"
 D ^DIR
 I $D(DUOUT)!($D(DTOUT))!(+Y'>0) W !!,"OK BYE BYE" S OK=0 QUIT
 ;
 S LRD0=$S(Y=1:"FIRST",Y=2:"SECOND",Y=3:"THIRD",Y=4:"FOURTH",1:"FIFTH")
 S OK=1 S LRD0="D "_LRD0
 X LRD0
 ;
 K DIR
 I 'OK D END QUIT
 S LREDT3=LREDT
 ;
 QUIT
 ;
END ;
QUIT ;
 D QUIT^LRARCHIV
 QUIT
 ;
 ;
FIRST ;--------->by nuber of days
 K DIR SET DIR(0)="N" S DIR("B")="90" S DIR("A")="Enter # of days"
 D ^DIR
 I $D(DUOUT)!($D(DTOUT))!(+Y'>0) W !!,"OK BYE BYE" S OK=0 QUIT
 S X1=LR(1),X2=-Y D C^%DTC
 W !,$$FMTE^XLFDT(X,"D")," TO ",$$FMTE^XLFDT(LR(1),"D")
 S LREDT=X
 K DIR D PASTIT
 QUIT
SECOND ;---------->by date range
 S %DT="AE"
 S %DT("B")="T-90"
 S %DT("A")="Start Date: "
 D ^%DT I Y'>0 S OK=0 D END QUIT
 S LR(1)=Y
 S %DT("B")="T-30"
 S %DT("A")="Ending Date: "
 D ^%DT I Y'>0 S OK=0 D END QUIT
 S LREDT=Y
 S LRY0=LREDT,LREDT=LR(1),LR(1)=LRY0 ;SWAP
 ;I LR(1)>LREDT S X=LR(1),LR(1)=LREDT,LREDT=X
 K %DT
 D PASTIT
 QUIT
THIRD ;----------->by month
 S %DT="AE"
 S %DT("B")=+$E(DT,4,5)_"/"_+$E(DT,2,3)
 S %DT("?")="Enter Month/Year...May 1997...June 1994"
 S %DT("??")="9/94 for September 1994"
 S %DT("A")="Month and year: "
 D ^%DT I Y'>0 S OK=0 QUIT
 ;
 I +$E(Y,4,4)++$E(Y,5,5)'>0 W !!,"You forgot the month." G THIRD
 ;
 S LR(1)=$E(Y,1,5)_"01" S LREDT=$E(LR(1),1,3)_$E(LR(1),4,5)+1_"01"
 S LRY0=LREDT,LREDT=LR(1),LR(1)=LRY0 ;SWAP
 K %DT
 D PASTIT
 QUIT
 ;
FOURTH ;--------------->by quarter
 K DIR
 S DIR(0)="S^1:1st Quarter;2:2nd Quarter;3:3rd Quarter;4:4th Quarter"
 S DIR("B")=1
 S DIR("?")="1=Jan-Feb-Mar 2=Apr-May-June 3=Jul-Aug-Sep 4=Oct-Nov-Dec"
 D ^DIR
 I $D(DTOUT)!($D(DUOUT)) S OK=0 D END QUIT
 S LRQQ=Y
 D AGAIN
 S LRQQ=$S(LRQQ=1:"FIRSTQ(LRYEAR)",LRQQ=2:"SECONDQ(LRYEAR)",LRQQ=3:"THIRDQ(LRYEAR)",1:"FOURTHQ(LRYEAR)")
 S LRQQ="D "_LRQQ X LRQQ
 D PASTIT
 QUIT
AGAIN ;
 ;
 I 'OK D END QUIT
 K %DT
 S %DT="AE" S %DT("A")="Please Enter a Year: "
 S %DT("B")=$S($E(DT,1,1)=2:19_$E(DT,2,3),1:20_$E(DT,2,3))
 D ^%DT
 I Y'>0 S OK=0 D END QUIT
 S LRYEAR=Y
 QUIT
 ;
FIFTH ;
 D AGAIN
 I 'OK D END QUIT
 S LR(1)=$E(Y,1,3)_0101
 S LREDT=$E(Y,1,3)_1231
 ;
PASTIT ;
 ;W !!,"LREDT=",LREDT,"<------>LR(1)=",LR(1)
 Q
QUARTER ;
 ;
FIRSTQ(LRYEAR) ;
 S LRYQ=$E(LRYEAR,2,3)
 S LR(1)=2_LRYQ_"0101",LREDT=2_LRYQ_"0331"
 QUIT
 ;
SECONDQ(LRYEAR) ;
 S LRYQ=$E(LRYEAR,2,3)
 S LR(1)=2_LRYQ_"0401",LREDT=2_LRYQ_"0630"
 QUIT
 ;
THIRDQ(LRYEAR) ;
 S LRYQ=$E(LRYEAR,2,3)
 S LR(1)=2_LRYQ_"0701",LREDT=2_LRYQ_"0930"
 QUIT
 ;
FOURTHQ(LRYEAR) ;
 S LRYQ=$E(LRYEAR,2,3)
 S LR(1)=2_LRYQ_"1001",LREDT=2_LRYQ_"1231"
 QUIT
 ;
DAYS ;
 ;
 Q
 ;
 QUIT