| 1 | LRRSP ;SLC/RWF/BA - INTERIM REPORT FOR SELECTED TESTS AS ORDERED ;8/11/97 | 
|---|
| 2 | ;;5.2;LAB SERVICE;**121,283**;Sep 27, 1994 | 
|---|
| 3 | ;from option LRRSP | 
|---|
| 4 | BEGIN D:'$D(LRPARAM) ^LRPARAM S LREND=0 F  S LRSTOP=0 K DFN,DIC D PAT Q:LREND | 
|---|
| 5 | END D ^LRRK | 
|---|
| 6 | Q | 
|---|
| 7 | PAT S (LRPG,LRPRTPG)=0 D ^LRDPA I LRDFN=-1 S LREND=1 Q | 
|---|
| 8 | I $O(^LR(LRDFN,0))="" W !,"NO LAB DATA ON THIS PATIENT!",$C(7) Q | 
|---|
| 9 | S LRTSCRN=0,LRONETST="",LRONESPC="",DIC="^LAB(60,",DIC(0)="AEMOQ",DIC("S")="I ""BO""[$P(^(0),U,3)",DIC("A")="Select ORDERED TEST: ANY//" D ^DIC S:Y>0 LRTSCRN=+Y,LRONETST=LRTSCRN S:$D(DUOUT)!$D(DTOUT) LREND=1 Q:LREND | 
|---|
| 10 | K DIC,LRCW S LREDT="T-7" D ^LRWU3 Q:LREND  S LRSDT=LRSDT\1 | 
|---|
| 11 | ASKPG S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO" | 
|---|
| 12 | D ^DIR K DIR | 
|---|
| 13 | I Y S LRPRTPG=1 | 
|---|
| 14 | S ZTRTN="DQ^LRRSP",%ZIS="MQ" D IO^LRWU | 
|---|
| 15 | Q | 
|---|
| 16 | DQ ;dequeued | 
|---|
| 17 | S:$D(ZTQUEUED) ZTREQ="@" U IO | 
|---|
| 18 | S LRFOUND=0,LRODT=LRSDT F  D ORDER Q:LREND!LRSTOP  S X1=LRODT,X2=-1 D C^%DTC S LRODT=X Q:LRODT<LREDT | 
|---|
| 19 | I 'LRFOUND W !,"No data found to print for - " S Y=LRSDT D DD^LRX W Y_" TO " S Y=LREDT D DD^LRX W $S($E(Y)'[9:Y,1:"END OF ON LINE RECORDS") | 
|---|
| 20 | D:LRPRTPG PLSPG^LRRP2 | 
|---|
| 21 | W @IOF | 
|---|
| 22 | Q | 
|---|
| 23 | ORDER S LRORDER="",LRSN=0 F  S LRSN=+$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1  D SCREEN S:X LRORDER=LRORDER_LRSN_U | 
|---|
| 24 | D SET^LRRP | 
|---|
| 25 | Q | 
|---|
| 26 | SCREEN S X=0 I 'LRTSCRN S X=1 Q | 
|---|
| 27 | S T=0 F  S T=$O(^LRO(69,LRODT,1,LRSN,2,T)) Q:T<1  I +^(T,0)=LRTSCRN,'$P(^(0),"^",11) S X=1 Q | 
|---|
| 28 | Q | 
|---|