1 | LRSMAC ;SLC/RWF - CHEM. LAB SMAC REPORT ;2/19/91 13:08 ;
|
---|
2 | ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
|
---|
3 | PR1 S LRRN=1 G PR ;ASTRA
|
---|
4 | PR2 S LRRN=2 G PR ;SMAC
|
---|
5 | 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)
|
---|
6 | Q
|
---|
7 | ZLH I LRZZ,LRZZ<L(K)!(LRZZ>H(K)) W $E("LH",LRZZ>H(K)+1)
|
---|
8 | Q
|
---|
9 | PR Q:(LRDFN=-1) K LRIDT,LRSV S LRIDT=0,%DT="",LRNL=""
|
---|
10 | IF '$D(^LR(LRDFN,"CH")) W !!,"NO DATA" K LRDFN Q
|
---|
11 | 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
|
---|
12 | PALL K LRIDT,LRSV S LRIDT=0,%DT="",LRNL=""
|
---|
13 | S U="^",LREND=0,J=0 D HEAD,LH
|
---|
14 | S LRPQ="^22^16^9^27^32^37^42^47^9^15^21^27^34^42^48^54^59^63^68^73"
|
---|
15 | 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))"
|
---|
16 | PRL D:$Y+4>(IOSL\LRRN) PRL2,WAIT,HEAD:'LREND G K:LREND S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) G LREND:LRIDT<1
|
---|
17 | S Z0=^LR(LRDFN,"CH",LRIDT,0) G PRL:'$P(Z0,U,3)
|
---|
18 | K LREM S LREM=0 F S LREM=$O(^LR(LRDFN,"CH",LRIDT,1,LREM)) Q:LREM<1 S LREM(LREM)=^(LREM,0)
|
---|
19 | 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))
|
---|
20 | G:L=0 PRL
|
---|
21 | D DAT W:DT-$E(Z0,1,7)>300 !,1700+$E(Z0,1,3) W !,Y,?6,LRSPEC
|
---|
22 | F I=4,3,2,5:1:9 S LRZZ=Z(I) X LRXW
|
---|
23 | W ?57,T,?64,$P(Z0,U,8),?71,$P(Z0,U,6)
|
---|
24 | D PRL4 S:LRRN=2 LRSV($Y)=LRIDT G PRL
|
---|
25 | PRL2 Q:'$D(LRSV) Q:$O(LRSV(0))<1 D H3
|
---|
26 | S LRSV=0 F S LRSV=$O(LRSV(LRSV)) Q:LRSV<1 S Z0=^LR(LRDFN,"CH",LRSV(LRSV),0) D PRL3
|
---|
27 | K LRSV Q
|
---|
28 | PRL3 D DAT W:DT-$E(Z0,1,7)>300 !,1700+$E(Z0,1,3) W !,Y,?6,LRSPEC
|
---|
29 | 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))
|
---|
30 | Q:L=0 F I=10:1:21 S LRZZ=Z(I) X LRXW
|
---|
31 | K LREM S LREM=0 F S LREM=$O(^LR(LRDFN,"CH",LRIDT,1,LREM)) Q:LREM<1 S LREM(LREM)=^(LREM,0)
|
---|
32 | PRL4 S LREM=0 F S LREM=$O(LREM(LREM)) Q:LREM<1 W:$L(LREM(LREM))>0 !,"NOTE: ",LREM(LREM)
|
---|
33 | W:$O(LREM(0)) ! Q
|
---|
34 | HEAD W @IOF S LRLDT=0
|
---|
35 | S X=$H X ^%ZOSF("ZD") W $$INS^LRU," CHEMISTRY REPORT ",Y," ",SSN," ",PNM,?72,"AGE ",AGE
|
---|
36 | H2 W !,"DATE S/U",?9,"CREAT UREA GLU NA K CL CO2 CA TIME METH LOG"
|
---|
37 | Q
|
---|
38 | H3 S LRDX=0,LRDY=10 ;X XY
|
---|
39 | W !?5,"S/U PO4 URIC CHOLEST T-PROT ALBUMIN T-BIL D-BIL AKL0 LDH SGOT SGPT GGPT" Q
|
---|
40 | DAT S X=+Z0,Y=$$FMTE^XLFDT(X,"5Z"),T=$P(Y,"@",2),Y=$P(Y,"@")
|
---|
41 | 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:" ")
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | WAIT R !!,"PRESS '^' TO STOP ",J:DTIME U IO S:J="" J=1 S LREND=".^"[J Q
|
---|
45 | LREND D PRL2 W !," last data " D:$D(LRIDT) WAIT
|
---|
46 | K D ^%ZISC K LRIDT,LRRN,LRPQ,LRDY,LRXW,Z,L,H Q
|
---|