source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRACSUM6.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1LRACSUM6 ;SLC/DCM - PRINT INDIVIDUAL PATIENT SUMMARY (MISC.) ; 3/9/88 10:23 ;
2 ;;5.2;LAB SERVICE;**47,201,225**;Sep 27, 1994
3LRUDT S LRTIM=$E(LRFDT,9,12) F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
4 ;
5 S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
6Y2K1 ;
7 ;Q:$L(LRTIM)'>6
8 S LRUDT=$$Y2K^LRX($P(LRFDT,"."))_" "_$J(LRTIM,5)_" "
9 Q
10HEAD ;from LRACSUM3, LRACSUM4, LRACSUM5
11 D LRBOT D TOP Q
12LRBOT ;from LRACSUM3
13 W !
14Y I $Y'>(IOSL-6) W ! G Y
15 W $E($P(^TMP($J,LRDFN,0),U,1),1,20),?21,$P(^(0),U,2),?(IOM-40),"ROUTING: ",LRLLOC W !?10,$S('LRDIS:"** SUMMARY REPORT ** DO NOT FILE **",1:"** DISCHARGE SUMMARY **")
16 ; Y2K
17 I LRDIS S Y=9999999-LROUT S Y=$$Y2K^LRX(Y) W " From: ",Y," To: " S X1=9999999-$P(LRIN,"."),X2=-1 D C^%DTC S Y=X S Y=$$Y2K^LRX(Y) W Y ; NOIS DES-0495-40180 DRH
18 W:LRBOT="B" !,$S($D(^LAB(64.5,1,1,LRMH,0)):$P(^(0),U,2),1:"") W:LRBOT'="B" ! W ?(IOM-13)," PAGE: ",$S($D(LRMISC):"MISC",1:LRMH),":",LRPG ;Y2K
19 S LRTAB=(LRMH-1)*5#80 W !?LRTAB,$E(LRMHN,1,IOM-LRTAB) S LRPG=LRPG+1
20 Q
21TOP ;from LRACSUM3
22 W @IOF,!
23 S X=^TMP($J,LRDFN,0) W $P(X,U,1),?20,$P(X,U,2),?33,"AGE: ",$P(X,U,3)
24 I $P(X,U,4)=2,$D(^DPT(+$P(X,U,5),.1)) W ?(IOM-42)," LOC: ",^(.1)
25 W ?(IOM-22),LRCDT,?(IOM-12)," PAGE: ",$S($D(LRMISC):"MISC",1:LRMH),":",LRPG W:LRBOT="T" !,"VAMC ",$S($D(^LAB(64.5,1,1,LRMH,0)):$P(^(0),U,2),1:"") ;Y2K
26 S LRAG=0 Q
27KILL D HEAD Q
28 Q
29LRMISC S LRFDT=0,LRPG=1 D TOP
30MHI S LRMHN=$P(^TMP($J,LRDFN,LRMH),U,1),LRCNT=12 D WR
31MDT S LRFDT=$O(^TMP($J,LRDFN,"MISC",LRFDT)) G:LRFDT<1 END D LRUDT,LRCNT D:$Y>(IOSL-LRCNT) WR S LRMIT=0
32LRMIT S LRMIT=$O(^TMP($J,LRDFN,"MISC",LRFDT,LRMIT)) G:LRMIT="TX" TXT G:LRMIT="" MDT S X=^(LRMIT) G:LRMIT=.1 MSG
33 S LRLO="",LRHI="",LRVAL=$P(X,U,1),LRSPE=$P(X,U,2),LRTEST=$P(X,U,3),X1=$P(X,U,4) S LRSPEM=$S($L(LRSPE):$P(^LAB(61,LRSPE,0),U,1),1:"")
34 G:'LRTEST COMM S LRUNT="",LRNAME=$P(^LAB(60,LRTEST,.1),U,1) S:$L(LRSPE)&($D(^LAB(60,LRTEST,1,LRSPE,0))) X=^(0),@("LRLO="_$S($L($P(X,U,2)):$P(X,U,2),1:"""""")),@("LRHI="_$S($L($P(X,U,3)):$P(X,U,3),1:"""""")),LRUNT=$P(X,U,7)
35WR1 W !!,LRUDT,?15,LRSPEM,?36,LRNAME,":",?50,LRVAL," ",X1," ",LRUNT,?67 W:$L(LRLO) LRLO,"-",LRHI
36 G LRMIT
37MSG W !! X X G LRMIT
38COMM W !,"COMMENT: ",LRVAL G LRMIT
39WR I $Y>(IOSL-LRCNT) D EQUALS^LRX
40 I D HEAD
41 S LRCL=21-$L(LRMHN) W !!!?LRCL F I=1:1:8 W "* "
42 F I=1:1:$L(LRMHN) W " ",$E(LRMHN,I)
43 W " " F I=1:1:8 W " *"
44 W !!," DATE TIME SPECIMEN",?37,"TEST",?50,"VALUE",?64,"Ref ranges" D DASH^LRX
45 Q
46TXT S I=0 F S I=$O(^TMP($J,LRDFN,"MISC",LRFDT,"TX",I)) Q:'I W !,^(I,0)
47 G LRMIT
48END D EQUALS^LRX
49 D LRBOT S LRLO="" K LRSB,LRMISC Q
50PRE ;from LRACSUM3
51 Q:$D(^TMP($J,LRDFN,"MISC"))'=11 S LRMISC=1,LRPG=0,LRMH="MISC" G LRMISC
52LRCNT S LRCNT=0,I=0 F S I=$O(^TMP($J,LRDFN,LRMH,LRFDT,I)) Q:'I S LRCNT=LRCNT+1
53 S LRCTN=0 I $D(^(LRFDT,"TX")) S J=0 F S J=$O(^TMP($J,LRDFN,LRMH,LRFDT,"TX",J)) Q:'J S LRCTN=LRCTN+1
54 S LRCNT=LRCNT*2+5+LRCTN
55 Q
Note: See TracBrowser for help on using the repository browser.