| [613] | 1 | LRSOR ;SLC/RWF/CJS - SOME SPECIAL OUTPUT ROUTINES ;2/6/91 15:19 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
|---|
| 3 | D ^LRDPA G DONE:LRDFN<1 G LRA
|
|---|
| 4 | LRC ;NON SMAC CHEMISTRIES
|
|---|
| 5 | I LRDFN<1 W !,"NO DATA",! Q
|
|---|
| 6 | R !,"DO YOU WANT (R)IA TESTS, (N)ON SMAC TESTS, (H)EMA other than CBC: ",X:DTIME
|
|---|
| 7 | Q:"RNH"'[$E(X,1) G HEM:$E(X,1)="H",LRR:$E(X,1)="R"
|
|---|
| 8 | LRCC D LPA G DONE:POP S DIC=DIC_Q_"CH"","
|
|---|
| 9 | S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 S LRMETH=$P(^(LRIDT,0),U,8) D LROK IF LROK,'(LRMETH="ASTRA"!(LRMETH="SMAC"))!$L($S($D(^(40)):^(40),1:"")) S DA=LRIDT,DR="0:99999999" D EN^LRDIQ D WAIT Q:LREND W !!
|
|---|
| 10 | G DONE
|
|---|
| 11 | LROK S LROK=0 Q:'$P(^LR(LRDFN,"CH",LRIDT,0),U,3) S LRZX=$O(^LR(LRDFN,"CH",LRIDT,21)) S:LRZX>0&(LRZX<384) LROK=1 Q
|
|---|
| 12 | LPA ;
|
|---|
| 13 | I $D(LRPRETTY) S DIC="^LR("_LRDFN_",",Q="""",LREND=0,LRIDTE=LRSDT,LRIDTS=LREDT Q
|
|---|
| 14 | S POP=1 W:LRDFN<1 !,"NO DATA",! Q:LRDFN<1
|
|---|
| 15 | LPT R !,"Starting Date: N//",X:DTIME Q:X["^" S:X="" X="N" S %DT="ETX" D ^%DT G LPT:Y<1
|
|---|
| 16 | S Y=9999999-Y,Y=$O(^LR(LRDFN,"CH",Y-.00001)),X=9999999-Y,LRIDTE=Y-.00001
|
|---|
| 17 | W !,"First data of any kind on ",$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
|
|---|
| 18 | LPT1 R !,"Number of days to check for data: 20//",X:DTIME Q:X["^" S:X="" X=20 I +X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) W !,"Type a number between 1 and 99999." G LPT1
|
|---|
| 19 | S X="T-"_X,%DT="E" D ^%DT S LRIDTS=9999999-Y G LPT1:Y<1
|
|---|
| 20 | K %ZIS D ^%ZIS Q:POP
|
|---|
| 21 | U IO S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D DT^LRX,PT^LRX D HEAD S DIC="^LR("_LRDFN_",",Q="""",LREND=0 Q
|
|---|
| 22 | LPB Q:LRDFN<1 S DIC=DIC_Q_LRSS_Q_"," S LRIDT=LRIDTE F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LRIDT<1 Q:LRIDT>LRIDTS IF $P(^LR(LRDFN,LRSS,LRIDT,0),U,3) D LPC Q:LREND W !
|
|---|
| 23 | G DONE
|
|---|
| 24 | LPC S LRDR=$O(^LR(LRDFN,LRSS,LRIDT,LRDR1-1)) I LRDR>LRDR2!(LRDR<1) Q
|
|---|
| 25 | S DA=LRIDT,Z=^LR(LRDFN,LRSS,LRIDT,0),Y=+Z,X=$P(Z,U,5) D DD^LRX
|
|---|
| 26 | W !,"DATE&TIME: ",Y W:$L($P(Z,U,8)) ?35,"METHOD/SITE: ",$P(Z,U,8) W ?55,"ACC: ",$P(Z,U,6)
|
|---|
| 27 | W !,"SPECIMEN: ",$S($D(^LAB(61,+X,0)):$P(^(0),U,1),1:"??"),!?2
|
|---|
| 28 | S DR="0:9999999" K DX D EN^LRDIQ,WAIT Q
|
|---|
| 29 | WAIT I $E(IOST,1,2)="C-" W !,PNM," ",SSN," PRESS '^' TO STOP " R X:DTIME S:$L(X) LREND=".^"[X Q
|
|---|
| 30 | Q:$Y+6<IOSL W !! W:$E(IOST)="P" @IOF
|
|---|
| 31 | HEAD W !!,"WORK COPY ONLY - DO NOT FILE",!,PNM,?30,SSN,?50,LRDT0,! Q
|
|---|
| 32 | LRR ;RADIO IMMUNO ASSAY / NUCLEAR ENDOCRINOLOGY
|
|---|
| 33 | D LPA G DONE:POP S LRSS="CH",LRDR1=734,LRDR2=774 G LPB
|
|---|
| 34 | LRP ;SURGICAL PATHOLOGY
|
|---|
| 35 | D LPA G DONE:POP S LRSS="SP" G LPB
|
|---|
| 36 | MIC ;MICROBIOLOGY
|
|---|
| 37 | D LPA G DONE:POP S LRSS="MI" G LPB
|
|---|
| 38 | HIS ;HISTOLOGY & CYTOLOGY
|
|---|
| 39 | D LPA G DONE:POP S LRSS="HI" G LPB
|
|---|
| 40 | SER ;SEROLOGY
|
|---|
| 41 | D LPA G DONE:POP S LRSS="CH",LRDR1=541,LRDR2=680 G LPB
|
|---|
| 42 | LUR ;URINALYSIS
|
|---|
| 43 | D LPA G DONE:POP S LRSS="CH",LRDR1=683,LRDR2=733 G LPB
|
|---|
| 44 | HEM ;HEMATOLOGY
|
|---|
| 45 | D LPA G DONE:POP S LRSS="CH",LRDR1=384,LRDR2=540 G LPB
|
|---|
| 46 | DIFF ;DIFFERENTIAL
|
|---|
| 47 | D LPA G DONE:POP S LRSS="CH",LRDR1=394,LRDR2=404 G LPB
|
|---|
| 48 | LRA ;LISTS ALL LAB RESULTS
|
|---|
| 49 | D LPA G DONE:POP S LRSS="CH",LRDR1=1,LRDR2=1000000 G LPB
|
|---|
| 50 | DONE D ^%ZISC K LRDR,LRDR1,LRDR2,LRIDTE,LRIDTS Q
|
|---|
