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

LRSMAC.m

Go to the documentation of this file.
LRSMAC ;SLC/RWF - CHEM. LAB SMAC REPORT ;2/19/91  13:08 ;
 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
PR1 S LRRN=1 G PR ;ASTRA
PR2 S LRRN=2 G PR ;SMAC
LH F I=173:1:193 S:$D(^LAB(60,I,1,LRSERUM,0)) Z=^(0),L(I-172)=$P(Z,U,3),H(I-172)=$P(Z,U,4)
 Q
ZLH I LRZZ,LRZZ<L(K)!(LRZZ>H(K)) W $E("LH",LRZZ>H(K)+1)
 Q
PR Q:(LRDFN=-1)  K LRIDT,LRSV S LRIDT=0,%DT="",LRNL=""
 IF '$D(^LR(LRDFN,"CH")) W !!,"NO DATA" K LRDFN Q
 K %ZIS D ^%ZIS Q:POP  S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX U IO W @IOF
PALL K LRIDT,LRSV S LRIDT=0,%DT="",LRNL=""
 S U="^",LREND=0,J=0 D HEAD,LH
 S LRPQ="^22^16^9^27^32^37^42^47^9^15^21^27^34^42^48^54^59^63^68^73"
 S LRXW="IF $L(LRZZ) W ?$P(LRPQ,U,I),$S(""<>""[$E(LRZZ):$J(LRZZ,4),LRZZ#1:$J(LRZZ,4,1)_$P(LRZZ,+LRZZ,2),1:$J(+LRZZ,4))"
PRL D:$Y+4>(IOSL\LRRN) PRL2,WAIT,HEAD:'LREND G K:LREND S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) G LREND:LRIDT<1
 S Z0=^LR(LRDFN,"CH",LRIDT,0) G PRL:'$P(Z0,U,3)
 K LREM S LREM=0 F  S LREM=$O(^LR(LRDFN,"CH",LRIDT,1,LREM)) Q:LREM<1  S LREM(LREM)=^(LREM,0)
 S L=0 F Z=2:1:21 S Z(Z)=$S($D(^LR(LRDFN,"CH",LRIDT,Z)):$P(^(Z),U,1),1:""),L=L+$L(Z(Z))
 G:L=0 PRL
 D DAT W:DT-$E(Z0,1,7)>300 !,1700+$E(Z0,1,3) W !,Y,?6,LRSPEC
 F I=4,3,2,5:1:9 S LRZZ=Z(I) X LRXW
 W ?57,T,?64,$P(Z0,U,8),?71,$P(Z0,U,6)
 D PRL4 S:LRRN=2 LRSV($Y)=LRIDT G PRL
PRL2 Q:'$D(LRSV)  Q:$O(LRSV(0))<1  D H3
 S LRSV=0 F  S LRSV=$O(LRSV(LRSV)) Q:LRSV<1  S Z0=^LR(LRDFN,"CH",LRSV(LRSV),0) D PRL3
 K LRSV Q
PRL3 D DAT W:DT-$E(Z0,1,7)>300 !,1700+$E(Z0,1,3) W !,Y,?6,LRSPEC
 S L=0 F I=10:1:21 S Z(I)=$S($D(^LR(LRDFN,"CH",LRSV(LRSV),I)):^(I),1:""),L=L+$L(Z(I))
 Q:L=0  F I=10:1:21 S LRZZ=Z(I) X LRXW
 K LREM S LREM=0 F  S LREM=$O(^LR(LRDFN,"CH",LRIDT,1,LREM)) Q:LREM<1  S LREM(LREM)=^(LREM,0)
PRL4 S LREM=0 F  S LREM=$O(LREM(LREM)) Q:LREM<1  W:$L(LREM(LREM))>0 !,"NOTE: ",LREM(LREM)
 W:$O(LREM(0)) ! Q
 S X=$H X ^%ZOSF("ZD") W $$INS^LRU," CHEMISTRY REPORT  ",Y,"  ",SSN,"  ",PNM,?72,"AGE ",AGE
H2 W !,"DATE S/U",?9,"CREAT  UREA  GLU   NA    K   CL  CO2   CA       TIME   METH  LOG"
 Q
H3 S LRDX=0,LRDY=10 ;X XY
 W !?5,"S/U  PO4 URIC CHOLEST T-PROT ALBUMIN T-BIL D-BIL AKL0 LDH SGOT SGPT GGPT" Q
DAT S X=+Z0,Y=$$FMTE^XLFDT(X,"5Z"),T=$P(Y,"@",2),Y=$P(Y,"@")
 S T=T_$S($P(Z0,U,2):"r",1:"D"),LRSPEC=$P(Z0,U,5),LRSPEC=$S(LRSPEC=LRSERUM:"S",LRSPEC=LRURINE:"U",1:" ")
 Q
 ;
WAIT R !!,"PRESS '^' TO STOP ",J:DTIME U IO S:J="" J=1 S LREND=".^"[J Q
LREND D PRL2 W !," last data " D:$D(LRIDT) WAIT
K D ^%ZISC K LRIDT,LRRN,LRPQ,LRDY,LRXW,Z,L,H Q