| 1 | LRRP3 ;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
|
|---|
| 4 | BEGIN 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 !!
|
|---|
| 5 | END D ^LRRK
|
|---|
| 6 | Q
|
|---|
| 7 | PAT 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
|
|---|
| 19 | CHEM S LREXPD="S LRSUB=$P(^TMP(""LR"",$J,""T"",X),U,5),^TMP(""LR"",$J,""TMP"",$P(LRSUB,"";"",2))=X" D ^LREXPD
|
|---|
| 20 | Q
|
|---|
| 21 | MICRO 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
|
|---|
| 24 | DQ ;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
|
|---|
| 33 | SWITCH 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
|
|---|
| 39 | CH 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
|
|---|
| 42 | MI 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
|
|---|
| 45 | GO 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
|
|---|
