LRRD ;SLC/DCM/BA-INTERIM REPORT BY PHYSICIAN ;2/19/91  11:33
 ;;5.2;LAB SERVICE;**221,283**;Sep 27, 1994
 ;from option LRRD
BEGIN D ^LRPARAM S:'$D(LRSINGLE) LRSINGLE=0 S LRPRTPG=0 D MD
 I LRPRTPG,$D(PNM) D PLSPG^LRRP2
END D ^LRRK K LREDTR,LRSDTR
 Q
MD S (LREND,LRSTOP)=0,(LRONETST,LRONESPC,LRPHY,LRFPHY)="",LREPHY="ZZZZZZZZ",LRLAB=$S($D(LRLABKY):1,1:0) K DIC
DTRG ;Allow a date range for look up
 K LREDT D ^LRWU3 Q:LREND  S LRSDTR=$P(LRSDT,"."),LREDTR=LREDT,LREDT=9999999-LREDT
 ;K %DT S %DT("A")="DAILY REPORT FOR DAY: ",%DT="EQ" D DATE^LRWU Q:Y<1  K %DT S LRODT=Y,LRSDT=LRODT+.5,LREDT=9999999-LRODT
 S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO"
 D ^DIR K DIR
 I Y S LRPRTPG=1
 I 'LRSINGLE F  R !,"Do you want (A)ll providers, a (R)ange of providers,",!,"or (S)elected providers?  S// ",X:DTIME S:X="" X="S" Q:$L(X)=1&("ARS^"[X)  W !,"Enter 'A', 'R', 'S' or '^' to exit"
 I 'LRSINGLE Q:X[U  S LRMD=X
 D @$S(LRMD="S":"SELECT",LRMD="R":"RANGE",1:"QUE")
 Q
SELECT F  K DIC S DIC("A")="Select PROVIDER NAME: ",DIC="^VA(200,",DIC(0)="AEMQ",DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))",D="AK.PROVIDER" D ^DIC Q:Y<1  S LROK=1 D CHECK I LROK,LRSINGLE Q
 Q:$D(DUOUT)!$D(DTOUT)!'$L($O(LRPHY(0)))  D QUE
 Q
CHECK S LRPHY($E($P(Y,U,2),1,30))=""
 Q
RANGE K DIC S DIC("A")="Select STARTING PROVIDER NAME: ",DIC="^VA(200,",DIC(0)="AEMQ",DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))",D="AK.PROVIDER" D ^DIC Q:X=U
 S LRFPHY=$E($P(Y,U,2),1,30),LRFPHY=$S('$L(LRFPHY):"",1:$E(LRFPHY,1,$L(LRFPHY)-1)_$C($A(LRFPHY,$L(LRFPHY))-1))
 S DIC("A")="Select ENDING PROVIDER NAME: " D ^DIC Q:Y<1  S LREPHY=$E($P(Y,U,2),1,30)
QUE S %ZIS="MQ",ZTRTN="DQ^LRRD" D IO^LRWU
 Q
DQ ;dequeued
 K ^TMP($J) S:$D(ZTQUEUED) ZTREQ="@" U IO
 I $D(LREDTR),$D(LRSDTR) S LRODT=(LREDTR-.0001) F  S LRODT=$O(^LRO(69,LRODT)) Q:'LRODT!(LRODT>LRSDTR)!(LREND=1)  S:LRMD="A" LRFPHY="" D @$S(LRMD="S":"SEL",1:"RNG")
 I '$D(LREDTR),'$D(LRSDTR) D @$S(LRMD="S":"SEL",1:"RNG")
 K ^TMP($J)
 Q
SEL S (LREND,LRPHY)="",LRJ0=1 F  S LRPHY=$O(LRPHY(LRPHY)) Q:LRPHY=""  D PNAME S LRJ0=0 Q:LREND
 Q
RNG S LREND=0,LRJ0=1
 F  S LRPHY=$O(^LRO(69,LRODT,1,"AP",LRFPHY)) Q:LRPHY=""!(LRPHY]LREPHY)  D
 .S LRFPHY=LRPHY
 .D PNAME
 .S LRJ0=0
 .Q:LREND
 Q
PNAME S LRNAME="" F  S LRNAME=$O(^LRO(69,LRODT,1,"AP",LRPHY,LRNAME)) Q:LRNAME=""!(LREND=1)  D PAT Q:LREND
 Q
PAT S LRDFN=0 F  S LRDFN=+$O(^LRO(69,LRODT,1,"AP",LRPHY,LRNAME,LRDFN)) Q:LRDFN<1!(LREND=1)  S LRIDT=9999999-LRSDT D:'$D(^TMP($J,LRDFN)) DS^LRRP2 S:LRSTOP LREND=1 Q:LREND  S ^TMP($J,LRDFN)=""
 Q
SINGLE ;from option LRRD BY MD
 S LRSINGLE=1,LRMD="S" D BEGIN
 Q