source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRRP3.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.6 KB
Line 
1LRRP3 ;SLC/RWF/BA - INTERIM REPORT FOR SELECTED TESTS ;2/19/91 11:38
2 ;;5.2;LAB SERVICE;**283**;Sep 27, 1994
3 ;from option LRRP3
4BEGIN D:'$D(LRPARAM) ^LRPARAM W !!?20,"GENERAL LAB DATA DISPLAY" S LREND=0 F S (LRSTOP,LRPG,LRPRTPG)=0 D PAT Q:$G(LREND) W !!
5END D ^LRRK
6 Q
7PAT K DIC 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 K ^TMP("LR",$J),LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRHI,LRLO,LRUN,LRMI,LRMIEC,LRMF
10 S (LRONESPC,LRONETST)="",LRTSTS=0,DIC="^LAB(60,",DIC(0)="AEMOQ",DIC("S")="I $P(^(0),U,4)=""CH""!($P(^(0),U,4)=""MI"")"_$S('$D(LRLABKY):",""BO""[$P(^(0),U,3)",1:"") D ^DIC I Y<1 K DIC Q
11 F S LRTEST=+Y D @$S($P(^LAB(60,LRTEST,0),U,4)="CH":"CHEM",1:"MICRO") D ^DIC Q:Y'>0
12 K DIC,^TMP("LR",$J,"T"),LRORD Q:'LRTSTS
13 S LREDT="T-7",LRCW=8 D ^LRWU3 Q:LREND S LRSDT=9999999-LRSDT,LREDT=9999999-LREDT
14 S DIR(0)="Y",DIR("A")="Print address page",DIR("B")="NO"
15 D ^DIR K DIR
16 I Y S LRPRTPG=1
17 S ZTSAVE("^TMP(""LR"",$J,")="",ZTSAVE("DFN")="",ZTRTN="DQ^LRRP3" D IO^LRWU
18 Q
19CHEM S LREXPD="S LRSUB=$P(^TMP(""LR"",$J,""T"",X),U,5),^TMP(""LR"",$J,""TMP"",$P(LRSUB,"";"",2))=X" D ^LREXPD
20 Q
21MICRO S LRMI(LRTEST)="",LRTSTS=LRTSTS+1,LRMIEC=+$P(^LAB(60,LRTEST,0),U,14),LRMIEC=$S($D(^LAB(62.07,LRMIEC,.1)):^(.1),1:"")
22 S:LRMIEC["11.5" LRMF(1)="" S:LRMIEC["11.6" LRMF(2)="" S:LRMIEC["15" LRMF(5)="" S:LRMIEC["19" LRMF(8)="" S:LRMIEC["23" LRMF(11)="" S:LRMIEC["34" LRMF(16)="" I '$D(LRMF) K LRMIC(LRTEST) S LRTSTS=LRTSTS-1
23 Q
24DQ ;dequeued
25 D EN^LRPARAM Q:$G(LREND)
26 U IO S:$D(ZTQUEUED) ZTREQ="@"
27 D PT^LRX S LRHF=1,LRFOOT=0,LRIDT=LRSDT
28 F S LRCNIDT=+$O(^LR(LRDFN,"CH",LRIDT)),LRMNIDT=+$O(^LR(LRDFN,"MI",LRIDT)) Q:'LRCNIDT&'LRMNIDT D SWITCH Q:LREND!LRSTOP!(LRIDT>LREDT)
29 D FOOT^LRRP1
30 D:LRPRTPG PLSPG^LRRP2
31 W @IOF D ^LRRK
32 Q
33SWITCH I LRCNIDT=LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH,MI Q
34 I 'LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH Q
35 I 'LRCNIDT S LRIDT=LRMNIDT Q:LRIDT>LREDT D MI Q
36 I LRCNIDT<LRMNIDT S LRIDT=LRCNIDT Q:LRIDT>LREDT D CH Q
37 S LRIDT=LRMNIDT Q:LRIDT>LREDT D MI
38 Q
39CH Q:'$P(^LR(LRDFN,"CH",LRIDT,0),U,3)
40 S LRDN=0 F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN="" I $D(^TMP("LR",$J,"TMP",LRDN)) D GO Q
41 Q
42MI S (LROK,LRMF)=0 F S LRMF=+$O(LRMF(LRMF)) Q:LRMF<1 I $D(^LR(LRDFN,"MI",LRIDT,LRMF)) S LROK=1 Q
43 Q:'LROK S LRCDT=9999999-LRIDT,^TMP("LR",$J,"TP",1)="^MI",^(1,LRCDT)="",^(LRCDT,-1)="",LRSS="MI" S LRH=1 D:LRFOOT FOOT^LRRP1 Q:LRSTOP D EN1^LRMIPC S LRHF=1,LRFOOT=0 K A,Z,LRH S:LREND LREND=0,LRSTOP=1
44 Q
45GO K ^TMP("LR",$J,"TP") S LR0=^LR(LRDFN,"CH",LRIDT,0),LRCDT=+LR0,LRSS="CH",LRAA="",LROC=$P(LR0,U,11),LRAAO=1,LRTC=0,LRSPEC=$P(LR0,U,5)
46 D GO^LRRP
47 Q
Note: See TracBrowser for help on using the repository browser.