source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRD.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1LRRD ;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
4BEGIN D ^LRPARAM S:'$D(LRSINGLE) LRSINGLE=0 S LRPRTPG=0 D MD
5 I LRPRTPG,$D(PNM) D PLSPG^LRRP2
6END D ^LRRK K LREDTR,LRSDTR
7 Q
8MD S (LREND,LRSTOP)=0,(LRONETST,LRONESPC,LRPHY,LRFPHY)="",LREPHY="ZZZZZZZZ",LRLAB=$S($D(LRLABKY):1,1:0) K DIC
9DTRG ;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
19SELECT 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
22CHECK S LRPHY($E($P(Y,U,2),1,30))=""
23 Q
24RANGE 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)
27QUE S %ZIS="MQ",ZTRTN="DQ^LRRD" D IO^LRWU
28 Q
29DQ ;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
35SEL S (LREND,LRPHY)="",LRJ0=1 F S LRPHY=$O(LRPHY(LRPHY)) Q:LRPHY="" D PNAME S LRJ0=0 Q:LREND
36 Q
37RNG 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
44PNAME S LRNAME="" F S LRNAME=$O(^LRO(69,LRODT,1,"AP",LRPHY,LRNAME)) Q:LRNAME=""!(LREND=1) D PAT Q:LREND
45 Q
46PAT 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
48SINGLE ;from option LRRD BY MD
49 S LRSINGLE=1,LRMD="S" D BEGIN
50 Q
Note: See TracBrowser for help on using the repository browser.