source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSMAC.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1LRSMAC ;SLC/RWF - CHEM. LAB SMAC REPORT ;2/19/91 13:08 ;
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3PR1 S LRRN=1 G PR ;ASTRA
4PR2 S LRRN=2 G PR ;SMAC
5LH 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
7ZLH I LRZZ,LRZZ<L(K)!(LRZZ>H(K)) W $E("LH",LRZZ>H(K)+1)
8 Q
9PR 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
12PALL 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))"
16PRL 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
25PRL2 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
28PRL3 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)
32PRL4 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
34HEAD W @IOF S LRLDT=0
35 S X=$H X ^%ZOSF("ZD") W $$INS^LRU," CHEMISTRY REPORT ",Y," ",SSN," ",PNM,?72,"AGE ",AGE
36H2 W !,"DATE S/U",?9,"CREAT UREA GLU NA K CL CO2 CA TIME METH LOG"
37 Q
38H3 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
40DAT 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 ;
44WAIT R !!,"PRESS '^' TO STOP ",J:DTIME U IO S:J="" J=1 S LREND=".^"[J Q
45LREND D PRL2 W !," last data " D:$D(LRIDT) WAIT
46K D ^%ZISC K LRIDT,LRRN,LRPQ,LRDY,LRXW,Z,L,H Q
Note: See TracBrowser for help on using the repository browser.