source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRGEN.m@ 1150

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1LRGEN ;SLC/RWF - GENERAL REPORT FOR SELECTED TESTS ;8/11/97
2 ;;5.2;LAB SERVICE;**121,201,202,242**;Sep 27, 1994
3 ;from option LRGEN
4BEGIN D ^LRPARAM W !!?20,"GENERAL LAB DATA DISPLAY"
5 K DIC,LRTP S (LRTP,LREND)=0 D ^LRDPA I LRDFN'=-1 D GEN
6END K ^TMP("LR",$J),A8,C,DFN,DOB,DTOUT,DUOUT,I,II,IOBS,J,LRAA,LRAAC,LRAD,LRAN,LRCMNT,LRCW,LRDAT,LRDFN,LRDPF,LREDT,LREND,LREX,LREXPD,LRFFLG,LRFOOT,LRHDR,LRHI,LRIDT,LRIDT1,LRIX,LRLLT,LRLO,LRND,LRNG,LRNON,LRNOP,LRNOTE,LRONESPC,LRONETST
7 K LRORD,LRPAGE,LRPG,LRPP,LRPR,LRPS,LRSC,LRSDT,LRSSP,LRSUB,LRSV,LRTEST,LRTHER,LRTN,LRTP,LRTSTS,LRWPL,LRWRD,LRX,LRY,PNM,POP,S,S1,S2,SSN,T,X,Y,Z
8 K LRODT0
9 Q
10GEN I $O(^LR(LRDFN,0))="" W !,"NO LAB DATA ON THIS PATIENT!",$C(7) Q
11 S LRCW=10,LRPAGE=0 K ^TMP("LR",$J),LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRSSP,LRHI,LRLO
12 D TESTS^LRGEN2 K DIC Q:LREND!'LRTSTS I LRTSTS>18 D GEN^LRRP2 Q
13DATE S LREDT="T-14" D ^LRWU3 Q:LREND S LREDT=9999999-LREDT K LRSV,DIC
14 Q:LRIX=0 S LREND=0,LRWPL=IOSL-(3*LRIX)\LRIX,LRSC=LRIX,LRIDT=9999999-LRSDT
15 F II=1:1:LRIX S LRIDT(II)=LRIDT
16 S %ZIS="MQ",ZTRTN="DQ^LRGEN1" D IO^LRWU
17 Q
18EN2 ;from LRSOR1
19 D DATE
20 Q
21OR ;OE/RR entry point
22 Q:'$D(ORVP) S KILL=1 I '$D(LRPARAM) D EN^LRPARAM S KILL=0
23 D DT^LRX K DIC,LRTP S (LRTP,LREND)=0,DFN=+ORVP,LRDPF=+$P(@("^"_$P(ORVP,";",2)_"0)"),"^",2)_"^"_$P(ORVP,";",2) D END^LRDPA Q:LRDFN<1
24 D GEN,END
25 I 'KILL K LRBLOOD,LRDT0,LRPARAM,LRPLASMA,LRSERUM,LRUNKNOW,LRURINE
26 K KILL Q
27SET ;Initial Set up for CPRS call
28 N LRDONT
29 S (LRTP,LRPAGE,LREND)=0,LRCW=10,LRDONT=1
30 D SET^LRRP4,TESTS^LRGEN2
31 Q
32SET1 ;Print patient report for CPRS
33 I '$D(^DPT(DFN,"LR")) W !,"No Lab Data for: "_$P(^(0),"^") Q
34 S LRDFN=$$LRDFN^LR7OR1(DFN) I 'LRDFN W !,"No Lab Data for: "_$P(^DPT(DFN,0),"^") Q
35 I '$D(^LR(LRDFN,0)) W !,"No Lab Data for: "_$P(^DPT(DFN,0),"^") Q
36 I $D(LRPRETTY),$O(LRTEST(0)) S X=LRTEST($O(LRTEST(0))) I $L(X) D @X Q
37 I LRTSTS>18 W !!,"Too many tests! Will use alternate format. May show extra tests." S (LREND,LRFOOT,LRSTOP)=0,LRCW=8,LRHF=1,(LRONESPC,LRONETST)="" D GDQ^LRRP2 Q
38 S LRWPL=IOSL-(3*LRIX)\LRIX,LRSC=LRIX,LRIDT=LRSDT
39 F II=1:1:LRIX S LRIDT(II)=LRIDT
40 U IO S LRCW=LRCW-3,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRY=2 D DT^LRX,PT^LRX
41 D HEAD^LRGEN1
42 F I=0:0 D NX^LRGEN1 Q:LREND
43 Q
Note: See TracBrowser for help on using the repository browser.