source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRACSUM3.m@ 1078

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1LRACSUM3 ;SLC/DCM - PRINT INDIVIDUAL PATIENT SUMMARY ; 3/3/88 13:30 ;
2 ;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
3 S LRAG=0,LRYESCOM=0,LRIL=0,LRFULL=0
4 D LRMH S LRMH="MISC" G PRE^LRACSUM6
5LRMH S LRMH=0 F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:LRMH<1 S X=^(LRMH) D MH1
6 Q
7MH1 S LRMHN=$P(X,U,1),LRSH=0
8 S LRPG=1
9 D TOP^LRACSUM6
10 S LROFMT="",LRFDE=0 D LRSH D:'LRFDE LRBOT^LRACSUM6 K LRTM,^TMP($J,"TM") S LRFULL=0,LRTM=0,LROFMT="",LRFDE=0
11 Q
12LRSH ;from LRACSUM4, LRACSUM5
13 S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:LRSH<1 G:$D(^(LRSH))'=11 LRSH S X=^(LRSH),LRSHN=$P(X,U,1),LRTOPP=$P(X,U,2),LRSHD=$P(X,U,3),LRFMT=$P(X,U,4),LRFMT(1)=$E(LRFMT,1),LROFMT(1)=$E(LROFMT,1)
14 I (LROFMT["V"&(LRFMT["V"))!(LROFMT'=""&(LRFMT(1)'=LROFMT(1))) S LROFMT="" D HEAD^LRACSUM6
15 S LROFMT=LRFMT,LRTOPP=$E($P(^LAB(61,LRTOPP,0),U,1),1,13),LRTOT=0,LRPL=1,LRACT=0,LRJS=0,LRTS=0,LRFDE=0
16 S LRNP=0,LRFDT=0,LRLFDT=0,LRFFDT=0 D LRNP
17LOOP ;from LRACSUM5
18 I LRACT<LRPL S LRFDT=LRFFDT G:LRFMT["H" TS^LRACSUM5 I LRFMT["V" S LRMULT=1,LRMU=0 D MUL G BS^LRACSUM4
19 D TXT1^LRACSUM5 I LRCTR'<LRLNS!(IOSL-18<$Y) S LRFULL=1 S:'LRFDT LRFED=1 D:LRFDE LRBOT^LRACSUM6 D:'LRFDT HEAD^LRACSUM6 S LRFULL=0 G LRSH
20 G LRSH
21LRNP ;from LRACSUM4
22 S I=0 F S I=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,I)) Q:I<1 S LRTOT=LRTOT+$P(^(I,0),U,2) I LRTOT>(IOM-20) S LRPL=LRPL+1,LRTOT=$P(^(0),U,2)
23LRLNS ;from LRACSUM5
24 K LRTM,^TMP($J,"TM") S LRTM=0
25 S LRLNS=((IOSL-18)-($Y+(6*LRPL)))\LRPL
26 S LRCL=(IOM/2)-(5+($L(LRSHN)/2)) W !!?LRCL,"---- ",LRSHN," ----"
27 S LRACT=0,LRJS=0,LRNP=1
28 Q
29UDT ;from LRACSUM4, LRACSUM5
30 S LRBDT=LRFDT,LRFDT=$S($P(^LAB(64.5,1,1,LRMH,1,LRSH,0),U,3)["I":$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,2),1:LRFDT),LRTIM=$E(LRFDT,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
31 S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
32 S LRUDT=$E($$Y2K^LRX($P(LRFDT,".")),1,5)_" "_$J(LRTIM,4)_" " S LRFDT=LRBDT D:LRTM LRTM
33 Q
34LRTM S LRNXSW=0 S:'$D(LRTM(0)) LRTM(0)=96
35 I $D(^TMP($J,"TM",LRFDT)) S LRNXSW=1
36 E I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX")) S LRTM(0)=LRTM(0)+1,LRNX=$C(LRTM(0)),^TMP($J,"TM",LRFDT)=LRNX,LRNXSW=1 S I=0 F S I=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",I)) Q:'I S ^TMP($J,"TM",LRFDT,I)=^(I,0)
37 ;S:LRNXSW LRUDT=$P(^TMP($J,"TM",LRFDT),U,1)_" "_LRUDT
38 D Y2KALT^LRAC3
39 Q
40MUL F I=0:0 Q:LRMULT*(LRSHD+15)>(IOSL-9) S LRMULT=LRMULT+1
41 Q
Note: See TracBrowser for help on using the repository browser.