| 1 | LRRD ;SLC/DCM/BA-INTERIM REPORT BY PHYSICIAN ;2/19/91 11:33
|
|---|
| 2 | ;;5.2;LAB SERVICE;**221,283**;Sep 27, 1994
|
|---|
| 3 | ;from option LRRD
|
|---|
| 4 | BEGIN D ^LRPARAM S:'$D(LRSINGLE) LRSINGLE=0 S LRPRTPG=0 D MD
|
|---|
| 5 | I LRPRTPG,$D(PNM) D PLSPG^LRRP2
|
|---|
| 6 | END D ^LRRK K LREDTR,LRSDTR
|
|---|
| 7 | Q
|
|---|
| 8 | MD S (LREND,LRSTOP)=0,(LRONETST,LRONESPC,LRPHY,LRFPHY)="",LREPHY="ZZZZZZZZ",LRLAB=$S($D(LRLABKY):1,1:0) K DIC
|
|---|
| 9 | DTRG ;Allow a date range for look up
|
|---|
| 10 | K LREDT D ^LRWU3 Q:LREND S LRSDTR=$P(LRSDT,"."),LREDTR=LREDT,LREDT=9999999-LREDT
|
|---|
| 11 | ;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
|
|---|
| 12 | S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO"
|
|---|
| 13 | D ^DIR K DIR
|
|---|
| 14 | I Y S LRPRTPG=1
|
|---|
| 15 | 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"
|
|---|
| 16 | I 'LRSINGLE Q:X[U S LRMD=X
|
|---|
| 17 | D @$S(LRMD="S":"SELECT",LRMD="R":"RANGE",1:"QUE")
|
|---|
| 18 | Q
|
|---|
| 19 | 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
|
|---|
| 20 | Q:$D(DUOUT)!$D(DTOUT)!'$L($O(LRPHY(0))) D QUE
|
|---|
| 21 | Q
|
|---|
| 22 | CHECK S LRPHY($E($P(Y,U,2),1,30))=""
|
|---|
| 23 | Q
|
|---|
| 24 | 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
|
|---|
| 25 | 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))
|
|---|
| 26 | S DIC("A")="Select ENDING PROVIDER NAME: " D ^DIC Q:Y<1 S LREPHY=$E($P(Y,U,2),1,30)
|
|---|
| 27 | QUE S %ZIS="MQ",ZTRTN="DQ^LRRD" D IO^LRWU
|
|---|
| 28 | Q
|
|---|
| 29 | DQ ;dequeued
|
|---|
| 30 | K ^TMP($J) S:$D(ZTQUEUED) ZTREQ="@" U IO
|
|---|
| 31 | 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")
|
|---|
| 32 | I '$D(LREDTR),'$D(LRSDTR) D @$S(LRMD="S":"SEL",1:"RNG")
|
|---|
| 33 | K ^TMP($J)
|
|---|
| 34 | Q
|
|---|
| 35 | SEL S (LREND,LRPHY)="",LRJ0=1 F S LRPHY=$O(LRPHY(LRPHY)) Q:LRPHY="" D PNAME S LRJ0=0 Q:LREND
|
|---|
| 36 | Q
|
|---|
| 37 | RNG S LREND=0,LRJ0=1
|
|---|
| 38 | F S LRPHY=$O(^LRO(69,LRODT,1,"AP",LRFPHY)) Q:LRPHY=""!(LRPHY]LREPHY) D
|
|---|
| 39 | .S LRFPHY=LRPHY
|
|---|
| 40 | .D PNAME
|
|---|
| 41 | .S LRJ0=0
|
|---|
| 42 | .Q:LREND
|
|---|
| 43 | Q
|
|---|
| 44 | PNAME S LRNAME="" F S LRNAME=$O(^LRO(69,LRODT,1,"AP",LRPHY,LRNAME)) Q:LRNAME=""!(LREND=1) D PAT Q:LREND
|
|---|
| 45 | Q
|
|---|
| 46 | 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)=""
|
|---|
| 47 | Q
|
|---|
| 48 | SINGLE ;from option LRRD BY MD
|
|---|
| 49 | S LRSINGLE=1,LRMD="S" D BEGIN
|
|---|
| 50 | Q
|
|---|
