Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAC6

LRAC6.m

Go to the documentation of this file.
  1. LRAC6 ;SLC/DCM/MIWL/JMC - PRINT CUMULATIVE REPORT CONT. (MISC.) ; 1/31/89 15:02 ;
  1. ;;5.2;LAB SERVICE;**174,225**;Sep 27, 1994
  1. 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)
  1. Q:'$D(^LR(LRDFN,"CH",K(3),0)) S P=$P(^(0),U,9)
  1. S $P(^LR(LRDFN,"CH",K(3),0),U,9)=$S(P[LRMH_":"_LRPG:P,P[":":P_","_LRMH_":"_LRPG,1:LRMH_":"_LRPG)
  1. Q
  1. HEAD1 I 'LRFULL!(LRPERM=1) S LRKL=1
  1. 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
  1. K LRFD,K Q
  1. D LRBOT D TOP Q
  1. TOP ;from LRAC3
  1. W:$G(LRJ02)!($E(IOST,1,2)="C-") @IOF
  1. S LRJ02=1
  1. W !,PNM,?20,SSN,?33,"AGE: ",AGE
  1. I +LRDPF=2,$L($G(LRWRD)) W ?(IOM-42)," LOC: ",LRWRD
  1. W ?(IOM-22),$S($D(LRCDT):LRCDT,1:"??"),?(IOM-13),"PAGE: "
  1. W $S($D(LRMISC):"MISC",1:LRMH),":",LRPG W:LRBOT="T" !
  1. W !,$S($D(^LAB(64.5,1,1,LRMH,0)):$P(^(0),U,2),1:$P(^LAB(64.5,1,0),U,9))
  1. K ^TMP($J,"K") S LRKL=1,LRAG=0 Q
  1. LRBOT ;from LRAC3
  1. W !
  1. Y I $Y'>(IOSL-6) W ! G Y
  1. W $E(PNM,1,20),?21,SSN,?(IOM-46),"ROUTING: ",$E(LRLLOC,1,15),?(IOM-26)
  1. W $S(LRFULL!(LRPERM):" **PERMANENT**",1:" ")
  1. W " CHART COPY"
  1. W:LRBOT="B" !
  1. W $S($D(^LAB(64.5,1,1,LRMH,0)):$P(^(0),U,2),1:$P(^LAB(64.5,1,0),U,9))
  1. W:LRBOT'="B" !
  1. W ?(IOM-22),$S($D(LRCDT):LRCDT,1:"??"),?(IOM-13),"PAGE: "
  1. W $S($D(LRMISC):"MISC",1:LRMH),":",LRPG
  1. S LRTAB=(LRMH-1)*10#80 W !?LRTAB,$E(LRMHN,1,IOM-LRTAB)
  1. S:'$D(LRPG1) LRPG=LRPG+1
  1. Q
  1. LRUDT S LRTIM=$E(LRFDT,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
  1. S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
  1. S LRUDT=$E(LRFDT,4,5)_"/"_$E(LRFDT,6,7)_"/"_$E(LRFDT,2,3)_" "_$J(LRTIM,5)_" "
  1. Q
  1. LRKILL D HEAD1,HEAD Q
  1. Q
  1. LRMISC I LRPERM=0 Q:'$D(^LAC("LGOT",LRDFN,"MISC")) S:'$D(LRPG1) LRPG=LRPG+1 K ^TMP($J,"K")
  1. S LRFDT=0 D TOP
  1. MHI S LRMHN=$P(^LAC(LRXLR,LRDFN,LRMH,1,0),U,1),LRCNT=12 D WR
  1. MDT S LRFDT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT)) G:LRFDT<1 END
  1. I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG"),LRDPF=2 D REG^LRAC9
  1. D LRUDT,LRCNT,WR:($Y>(IOSL-LRCNT))
  1. S ^TMP($J,"K",LRFDT,0)=^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,0),LRMIT=0
  1. LRMIT S LRMIT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT)) G:LRMIT<1 TXT
  1. S ^TMP($J,"K",LRFDT,LRMIT)=$P(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT,0),U,5)
  1. S LRLO="",LRHI=""
  1. S LRVAL=$P(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,1,LRMIT,0),U,1),LRX19=^(0)
  1. S X1=$P(LRX19,U,4),LRSPE=$P(LRX19,U,2),LRTEST=$P(LRX19,U,3)
  1. S LRSPEM=$S($L(LRSPE):$P(^LAB(61,LRSPE,0),U,1),1:"")
  1. I 'LRTEST W !,"COMMENT: ",LRVAL G LRMIT
  1. S LRUNT="",LRNAME=$P(^LAB(60,LRTEST,.1),U,1),LRPC=$P(^(.1),U,3)
  1. 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)
  1. WR1 S:'$D(LRCW) LRCW=13 S X=LRVAL
  1. W !!,LRUDT,?15,LRSPEM,?36,LRNAME,":",?50,@$S(LRPC="":"X",1:LRPC)," "
  1. W X1," ",LRUNT,?67 W:$L(LRLO) LRLO,"-",LRHI
  1. I $D(IA) W !,IA K IA,IAX,IARNO,IADA
  1. G LRMIT
  1. WR I $Y>(IOSL-LRCNT) D EQUALS^LRX S LRFULL=1 D ENT^LRAC7,HEAD K ^TMP($J,"K") S LRFULL=0
  1. S LRCL=21-$L(LRMHN) W !!!?LRCL F I=1:1:8 W "* "
  1. F I=1:1:$L(LRMHN) W " ",$E(LRMHN,I)
  1. W " " F I=1:1:8 W " *"
  1. W !!," Date Time Specimen",?37,"Test",?50,"Results"
  1. W ?64,"Ref ranges" D DASH^LRX
  1. Q
  1. TXT S I=0
  1. F S I=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRFDT,"TX",I)) Q:'I W !,^(I,0)
  1. G MDT
  1. END D EQUALS^LRX
  1. D LRBOT S LRLO="" K LRSB,LRMISC Q
  1. PRE ;from LRAC3
  1. Q:$O(^LAC(LRXLR,LRDFN,"MISC",1,0))'>0 S LRX21=^(0)
  1. S LRMISC=1
  1. 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)
  1. S LRMH="MISC"
  1. S:'$L($P(^LAC(LRXLR,LRDFN,"MISC",1,0),U,2))!'$G(LRRE) $P(^(0),U,2)=LRPG
  1. G LRMISC
  1. LRCNT S LRCNT=0,I=0
  1. F S I=$O(^LAC(LRXLR,LRDFN,LRMH,1,1,LRFDT,1,I)) Q:I<1 S LRCNT=LRCNT+1
  1. 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
  1. S LRCNT=LRCNT*2+5+LRCTN
  1. Q