51 lines
2.5 KiB
Mathematica
51 lines
2.5 KiB
Mathematica
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
|