source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRSP.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1LRRSP ;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
4BEGIN D:'$D(LRPARAM) ^LRPARAM S LREND=0 F S LRSTOP=0 K DFN,DIC D PAT Q:LREND
5END D ^LRRK
6 Q
7PAT 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
11ASKPG 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
16DQ ;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
23ORDER 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
26SCREEN 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
Note: See TracBrowser for help on using the repository browser.