| 1 | LRAC6 ;SLC/DCM/MIWL/JMC - PRINT CUMULATIVE REPORT CONT. (MISC.) ; 1/31/89 15:02 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**174,225**;Sep 27, 1994
|
|---|
| 3 | LRFD1 S LRFD1=0 F S LRFD1=$O(^TMP($J,"K",K,LRFD,LRFD1)) Q:LRFD1<1 S ^LAC("LRKILL",LRDFN,LRMH,K,LRFD,LRFD1)=^TMP($J,"K",K,LRFD,LRFD1)
|
|---|
| 4 | Q:'$D(^LR(LRDFN,"CH",K(3),0)) S P=$P(^(0),U,9)
|
|---|
| 5 | S $P(^LR(LRDFN,"CH",K(3),0),U,9)=$S(P[LRMH_":"_LRPG:P,P[":":P_","_LRMH_":"_LRPG,1:LRMH_":"_LRPG)
|
|---|
| 6 | Q
|
|---|
| 7 | HEAD1 I 'LRFULL!(LRPERM=1) S LRKL=1
|
|---|
| 8 | E I 'LRRE S ^LR(LRDFN,"PG",LRMH)=LRMH_U_LRPG S K=0 F S K=$O(^TMP($J,"K",K)) Q:K<1 S LRFD=0 F S LRFD=$O(^TMP($J,"K",K,LRFD)) Q:LRFD<1 S Z=^(LRFD,0),K(2)=$P(Z,U,2),K(3)=$P(Z,U,3),^LAC("LRKILL",LRDFN,LRMH,K,LRFD,0)=Z D LRFD1
|
|---|
| 9 | K LRFD,K Q
|
|---|
| 10 | HEAD ;from LRAC3, LRAC4, LRAC5, LRAC7
|
|---|
| 11 | D LRBOT D TOP Q
|
|---|
| 12 | TOP ;from LRAC3
|
|---|
| 13 | W:$G(LRJ02)!($E(IOST,1,2)="C-") @IOF
|
|---|
| 14 | S LRJ02=1
|
|---|
| 15 | W !,PNM,?20,SSN,?33,"AGE: ",AGE
|
|---|
| 16 | I +LRDPF=2,$L($G(LRWRD)) W ?(IOM-42)," LOC: ",LRWRD
|
|---|
| 17 | W ?(IOM-22),$S($D(LRCDT):LRCDT,1:"??"),?(IOM-13),"PAGE: "
|
|---|
| 18 | W $S($D(LRMISC):"MISC",1:LRMH),":",LRPG W:LRBOT="T" !
|
|---|
| 19 | W !,$S($D(^LAB(64.5,1,1,LRMH,0)):$P(^(0),U,2),1:$P(^LAB(64.5,1,0),U,9))
|
|---|
| 20 | K ^TMP($J,"K") S LRKL=1,LRAG=0 Q
|
|---|
| 21 | LRBOT ;from LRAC3
|
|---|
| 22 | W !
|
|---|
| 23 | Y I $Y'>(IOSL-6) W ! G Y
|
|---|
| 24 | W $E(PNM,1,20),?21,SSN,?(IOM-46),"ROUTING: ",$E(LRLLOC,1,15),?(IOM-26)
|
|---|
| 25 | W $S(LRFULL!(LRPERM):" **PERMANENT**",1:" ")
|
|---|
| 26 | W " CHART COPY"
|
|---|
| 27 | W:LRBOT="B" !
|
|---|
| 28 | W $S($D(^LAB(64.5,1,1,LRMH,0)):$P(^(0),U,2),1:$P(^LAB(64.5,1,0),U,9))
|
|---|
| 29 | W:LRBOT'="B" !
|
|---|
| 30 | W ?(IOM-22),$S($D(LRCDT):LRCDT,1:"??"),?(IOM-13),"PAGE: "
|
|---|
| 31 | W $S($D(LRMISC):"MISC",1:LRMH),":",LRPG
|
|---|
| 32 | S LRTAB=(LRMH-1)*10#80 W !?LRTAB,$E(LRMHN,1,IOM-LRTAB)
|
|---|
| 33 | S:'$D(LRPG1) LRPG=LRPG+1
|
|---|
| 34 | Q
|
|---|
| 35 | LRUDT S LRTIM=$E(LRFDT,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
|
|---|
| 36 | S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
|
|---|
| 37 | S LRUDT=$E(LRFDT,4,5)_"/"_$E(LRFDT,6,7)_"/"_$E(LRFDT,2,3)_" "_$J(LRTIM,5)_" "
|
|---|
| 38 | Q
|
|---|
| 39 | LRKILL D HEAD1,HEAD Q
|
|---|
| 40 | Q
|
|---|
| 41 | LRMISC I LRPERM=0 Q:'$D(^LAC("LGOT",LRDFN,"MISC")) S:'$D(LRPG1) LRPG=LRPG+1 K ^TMP($J,"K")
|
|---|
| 42 | S LRFDT=0 D TOP
|
|---|
| 43 | MHI S LRMHN=$P(^LAC(LRXLR,LRDFN,LRMH,1,0),U,1),LRCNT=12 D WR
|
|---|
| 44 | MDT S LRFDT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT)) G:LRFDT<1 END
|
|---|
| 45 | I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG"),LRDPF=2 D REG^LRAC9
|
|---|
| 46 | D LRUDT,LRCNT,WR:($Y>(IOSL-LRCNT))
|
|---|
| 47 | S ^TMP($J,"K",LRFDT,0)=^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,0),LRMIT=0
|
|---|
| 48 | LRMIT S LRMIT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT)) G:LRMIT<1 TXT
|
|---|
| 49 | S ^TMP($J,"K",LRFDT,LRMIT)=$P(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT,0),U,5)
|
|---|
| 50 | S LRLO="",LRHI=""
|
|---|
| 51 | S LRVAL=$P(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT,0),U,1),LRX19=^(0)
|
|---|
| 52 | S X1=$P(LRX19,U,4),LRSPE=$P(LRX19,U,2),LRTEST=$P(LRX19,U,3)
|
|---|
| 53 | S LRSPEM=$S($L(LRSPE):$P(^LAB(61,LRSPE,0),U,1),1:"")
|
|---|
| 54 | I 'LRTEST W !,"COMMENT: ",LRVAL G LRMIT
|
|---|
| 55 | S LRUNT="",LRNAME=$P(^LAB(60,LRTEST,.1),U,1),LRPC=$P(^(.1),U,3)
|
|---|
| 56 | I $L(LRSPE),$D(^LAB(60,LRTEST,1,LRSPE,0)) S @("LRLO="_$S($L($P(^(0),U,2)):$P(^(0),U,2),1:"""""")),@("LRHI="_$S($L($P(^(0),U,3)):$P(^(0),U,3),1:"""""")),LRUNT=$P(^(0),U,7)
|
|---|
| 57 | WR1 S:'$D(LRCW) LRCW=13 S X=LRVAL
|
|---|
| 58 | W !!,LRUDT,?15,LRSPEM,?36,LRNAME,":",?50,@$S(LRPC="":"X",1:LRPC)," "
|
|---|
| 59 | W X1," ",LRUNT,?67 W:$L(LRLO) LRLO,"-",LRHI
|
|---|
| 60 | I $D(IA) W !,IA K IA,IAX,IARNO,IADA
|
|---|
| 61 | G LRMIT
|
|---|
| 62 | WR I $Y>(IOSL-LRCNT) D EQUALS^LRX S LRFULL=1 D ENT^LRAC7,HEAD K ^TMP($J,"K") S LRFULL=0
|
|---|
| 63 | S LRCL=21-$L(LRMHN) W !!!?LRCL F I=1:1:8 W "* "
|
|---|
| 64 | F I=1:1:$L(LRMHN) W " ",$E(LRMHN,I)
|
|---|
| 65 | W " " F I=1:1:8 W " *"
|
|---|
| 66 | W !!," Date Time Specimen",?37,"Test",?50,"Results"
|
|---|
| 67 | W ?64,"Ref ranges" D DASH^LRX
|
|---|
| 68 | Q
|
|---|
| 69 | TXT S I=0
|
|---|
| 70 | F S I=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,"TX",I)) Q:'I W !,^(I,0)
|
|---|
| 71 | G MDT
|
|---|
| 72 | END D EQUALS^LRX
|
|---|
| 73 | D LRBOT S LRLO="" K LRSB,LRMISC Q
|
|---|
| 74 | PRE ;from LRAC3
|
|---|
| 75 | Q:$O(^LAC(LRXLR,LRDFN,"MISC",1,0))'>0 S LRX21=^(0)
|
|---|
| 76 | S LRMISC=1
|
|---|
| 77 | I '$D(LRPG1) S LRPG=$S($L($P(LRX21,U,2))&($G(LRRE)):$P(LRX21,U,2),$D(^LR(LRDFN,"PG",LRMH)):$P(^(LRMH),U,2),1:0)
|
|---|
| 78 | S LRMH="MISC"
|
|---|
| 79 | S:'$L($P(^LAC(LRXLR,LRDFN,"MISC",1,0),U,2))!'$G(LRRE) $P(^(0),U,2)=LRPG
|
|---|
| 80 | G LRMISC
|
|---|
| 81 | LRCNT S LRCNT=0,I=0
|
|---|
| 82 | F S I=$O(^LAC(LRXLR,LRDFN,LRMH,1,1,LRFDT,1,I)) Q:I<1 S LRCNT=LRCNT+1
|
|---|
| 83 | S LRCTN=0 I $D(^LAC(LRXLR,LRDFN,LRMH,1,1,LRFDT,"TX")) S J=0 F S J=$O(^LAC(LRXLR,LRDFN,LRMH,1,1,LRFDT,"TX",J)) Q:'J S LRCTN=LRCTN+1
|
|---|
| 84 | S LRCNT=LRCNT*2+5+LRCTN
|
|---|
| 85 | Q
|
|---|
