source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACSUM5.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1LRACSUM5 ;SLC/DCM - PRINT INDIVIDUAL PATIENT SUMMARY ; 3/3/88 13:32 ;
2 ;;5.2;LAB SERVICE;**225**;Sep 27, 1994
3TS ;from LRACSUM3
4 I LRACT'=0 D EQUALS^LRX
5 K I S I=0,LRII=0 F S LRII=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRII)) Q:LRII<1 S I=I+1,I(I)=LRII
6 S LRFALT=0,LRCTR=0,LRACT=LRACT+1,J=LRJS+1,LRCL=$S($D(LRCALE(LRMH,LRSH)):24,1:20)
7 I J'>LRSHD W !! W:$D(LRCALE(LRMH,LRSH)) "Locale " W LRTOPP,?LRCL
8 F I=J:1:LRSHD S Z=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),LRCW=$P(Z,U,2) Q:(IOM-LRCL)<LRCW S LRCL=LRCL+LRCW,A=$L($P(Z,U,3))\2,B=LRCW\2 W $J($E($P(Z,U,3),1,(LRCW-1)),(A+B)),?LRCL
9 S LRJS=(I-1) S:LRACT=LRPL LRJS=LRJS+1
10 F I=J:1:LRJS Q:'$D(^LAB(64.5,"A",1,LRMH,LRSH,I(I))) S Z=^(I(I)) S:$L($P(Z,U,2))!$L($P(Z,U,11)) LRFALT=1
11 S LRCL=$S($D(LRCALE(LRMH,LRSH)):24,1:20)
12 I LRFALT W ! W:$D(LRCALE(LRMH,LRSH)) ?9 W $S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)):"Therapeutic",1:"Ref range"),?LRCL D TS1
13 F I=J:1:LRJS Q:'$D(^LAB(64.5,"A",1,LRMH,LRSH,I(I))) S:$L($P(^(I(I)),U,7)) LRFALT=1
14 I LRFALT S LRCL=$S($D(LRCALE(LRMH,LRSH)):24,1:20) W !?LRCL F I=J:1:LRJS D TS2
15 S LRFALT=0 D DASH^LRX
16LRFDT K A,B S:LRNP LRFFDT=LRFDT,LRNP=0 S LRFDT=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT)) G:LRFDT<1 LOOP^LRACSUM3 S LRTLOC=$P(^(LRFDT,0),U,1)
17 S:LRFDT>LRLFDT LRLFDT=LRFDT
18GOUT D QRS I LRCTR>LRLNS&(LRACT'<LRPL) S LRFULL=1 D TXT1 G:$O(^TMP($J,LRDFN,LRMH,LRSH,LRLFDT))<1 LRSH^LRACSUM3 D HEAD^LRACSUM6,LRLNS^LRACSUM3 S LRFULL=0,LRFDT=LRLFDT G TS
19 I LRCTR>LRLNS&(LRACT<LRPL) S LRFDT=LRFFDT G TS
20 G LRFDT
21QRS S LRCTR=LRCTR+1 F I=J:1:LRJS I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) S:$L(^(I(I))) LRFALT=1
22 Q:'LRFALT
23 S LRFALT=0,LRTM=1 D UDT^LRACSUM3 S LRCL=$S($D(LRCALE(LRMH,LRSH)):23,1:19),LRTM=0 W ! W:$D(LRCALE(LRMH,LRSH)) $E(LRTLOC,1,5) W:LRNXSW&($D(LRCALE(LRMH,LRSH))) ?6 W:'LRNXSW&('$D(LRCALE(LRMH,LRSH))) ?2 W:'LRNXSW&($D(LRCALE(LRMH,LRSH))) ?8 W LRUDT
24 F I=J:1:LRJS S LRG=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0) D QRS1
25 Q
26QRS1 W ?LRCL S LRCW=$P(LRG,U,2),LRDP=$P(^(0),U,6) Q:(IOM-LRCL)<LRCW
27 S LRCL=LRCL+LRCW I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) S X=^(I(I)) D C W:$L($P(LRG,U,4))&($L(X)) @$P(LRG,U,4),X1 I '$L($P(LRG,U,4)) W X_X1
28 K X2 Q
29TXT ;from LRACSUM4
30 S LRVAR=0
31 S LRIV=0 F S LRIV=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV)) Q:'LRIV S LRVAR=LRVAR+1 W:LRVAR>1 !?3 W ^(LRIV,0)
32 Q
33C2 Q:'$D(X2) F X3=1:1:$L(X) I $E(X,X3)'=" " S X=$E(X,1,X3-2)_X2_$E(X,X3,$L(X)) Q
34 K X3 Q
35LRLO ;from LRACSUM4
36 S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:""""""))
37LRHI S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7)
38 S LRLOHI=$S($L(LRHI):LRLO_"-"_LRHI_" ",1:LRLO) Q
39TXT1 ;from LRACSUM3, LRACSUM4
40 D EQUALS^LRX
41 S LRCL=(IOM/2)-24 W !!?LRCL F I=1:1:8 W "- "
42 F I=1:1:8 W " ",$E("COMMENTS",I)
43 W " " F I=1:1:8 W " -"
44 W !?7,"KEY: ""L""=Abnormal low, ""H""=Abnormal high, ""*""=Critical value",!
45 Q:'$D(LRTM(0)) S C6=0 F S C6=$O(^TMP($J,"TM",C6)) Q:C6="" W !," ",$P(^TMP($J,"TM",C6),U,1),". " S L(0)=0,L=0 F S L=$O(^TMP($J,"TM",C6,L)) Q:'L S L(0)=L(0)+1 W:L(0)>1 !," " W ^TMP($J,"TM",C6,L)
46 K C6,L Q
47C S X1=" "_$P(X,U,2),X=$P(X,U,1)
48 I $L($P(LRG,U,4)) S LRCW=LRCW-3 Q
49 I "<>"[$E(X,1),$E(X,2,$L(X))?.N.P1N S X2=$E(X,1),X=$E(X,2,$L(X))
50 S LRCW(1)=LRCW-3
51 I X?.N.P1N!(LRDP="")!(X?.N1".".N) S X=$S(LRDP="":$J(X,LRCW(1)),1:$J(X,LRCW(1),LRDP)) D C2
52 Q
53C1 ;from LRACSUM4
54 S LRCW=$S('$L(X1):7,1:10),X1=$S($L(X1)=1:" "_X1_" ",$L(X1)=0:X1,1:" "_X1)
55 I $L($P(LRG,U,4)) S LRCW=7 Q
56 S X=$S($L(X1):X_X1,1:X)
57 Q
58TS1 F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2),LRCL=LRCL+LRCW D LRLO S A=$L(LRLOHI)\2,B=LRCW\2 W $J(LRLOHI,(A+B)),?LRCL
59 Q
60TS2 S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2) Q:(IOM-LRCL)<LRCW S LRCL=LRCL+LRCW,A=$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,7))\2,B=LRCW\2 W $J($P(^(I(I)),U,7),(A+B)),?LRCL S LRFALT=0
61 Q
Note: See TracBrowser for help on using the repository browser.