source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAC4.m@ 1150

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1LRAC4 ;SLC/DCM - PRINT CUMULATIVE REPORT ; 5/16/88 10:49 ;
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3BS1 S ^TMP($J,"TY",K,"L")=$P(Z,U,2),^TMP($J,"K",LRSH,LRFDT,0)=LRSH_U_$P(Z,U,1)_U_$P(Z,U,5),LRTT=LRTT+1 S ^TMP($J,"Y2K",K)=$E($P($P($$Y2K^LRX(LRFDT),"."),"/",3),1,4)
4 S:LRFDT>LRLFDT LRLFDT=LRFDT D IA,UDT^LRAC3 S ^TMP($J,"TY",K,0)=$P(LRUDT," ",1),^TMP($J,"TY",K,"T")=$P(LRUDT," ",2)
5 ;
6 ;
7 ;
8 ;
9 F J=1:1:LRSHD I $D(I(J)) S:$D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,1,I(J),0)) T1=$P(^(0),U,1,2),T3=$P(^(0),U,3),^TMP($J,"TY",K,J)=T1,^TMP($J,"K",LRSH,LRFDT,LRKL)=T3,LRKL=LRKL+1 D BS3
10 K T1,T3 Q
11BS3 S:$D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,"TX"))&'$D(LRTX(LRTT)) LRTX(LRTT)=LRFDT
12 Q
13BS2 S X=$S($D(^TMP($J,"TY",J,I)):$P(^(I),U,1),1:""),X1=$S($L(X):$P(^(I),U,2),1:""),LRDP=$S($D(^TMP($J,"TY",I,"D")):^("D"),1:""),LRCL=LRCL+10
14 Q
15BS4 F J=0:1:(LRTT+1) W:J=0 ^TMP($J,"TY",J,I) W ?LRCL I J>0 D BS2 I $L(X) S LRCW=10 D:J<LRTT C1^LRAC9 W:$L($P(LRG,U,4))&(J<LRTT) @$P(LRG,U,4),X1 W:'$L($P(LRG,U,4))!(J'<LRTT) $J(X,LRCW)
16 Q
17BS ;from LRAC3
18 K I,^TMP($J,"TY") S LRCW=10,LRHI="",LRLO="",LRTT=1,I=0,LRTY=IOM-20\10,LRMU=LRMU+1
19 S LRII=0 F S LRII=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRII)) Q:LRII<1 S Z=^(LRII,0),P3=$P(Z,U,3),P6=$P(Z,U,6),I=I+1,I(I)=LRII,^TMP($J,"TY",0,I)=P3 S:P6 ^TMP($J,"TY",I,"D")=P6
20 K P3,P6
21 F K=1:1:(LRTY-1) S LRFDT=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT)) Q:LRFDT<1 S Z=^(LRFDT,0) D BS1
22 S:LRTT>(LRTY-1)&(LRMULT=1) LRFULL=1 S:LRTT>(LRTY-1)&(LRMU=(LRMULT-1)) LRFULL=1 F I=1:1:LRSHD I $D(I(I)) D LRLO^LRAC9 S:$L(LRLOHI) ^TMP($J,"TY",(LRTT+1),I)=LRLOHI S:$L(P7) ^TMP($J,"TY",LRTT,I)=P7 K P7
23 S ^TMP($J,"TY",LRTT,"T")="Units",^TMP($J,"TY",(LRTT+1),"T")="Ranges",^TMP($J,"TY",(LRTT+1),0)=$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(1)),U,11)):"Therapeutic",1:"Reference"),^TMP($J,"TY",LRTT,0)=""
24 W ! I $D(IA(0)) W IA(0) F I=1:1:(LRTT+1) W $S($D(IA(I)):$J(IA(I),10),1:$J("",10))
25 K IA,IAX,IARNO,IADA
26 I $D(LRCALE(LRMH,LRSH)) W !,"Locale " F I=1:1:(LRTT-1) W $J(^TMP($J,"TY",I,"L"),10)
27 ;
28Y2K ;
29 W !,$E(LRTOPP,1,7),?6 F I=1:1:(LRTT+1) W $J(^TMP($J,"TY",I,0),10)
30YEAR ;
31 W !?5 F I=1:1:(LRTT-1) W $J(^TMP($J,"Y2K",I),10)
32 W !?6 F I=1:1:(LRTT+1) W $J(^TMP($J,"TY",I,"T"),10)
33 ;W !,$E(LRTOPP,1,7),?7 F I=1:1:(LRTT+1) W $J(^TMP($J,"TY",I,0),6)," "
34 ;W !,$E(LRTOPP,1,7),?7 F I=1:1:(LRTT+1) W ^TMP($J,"TY",I,0)_" "
35 ;
36 ;W !?6 F I=1:1:(LRTT+1) W $J(^TMP($J,"TY",I,"T"),10) F LRC19=1:1:I W " "
37 ;W !?11 F I=1:1:(LRTT+1) W ^TMP($J,"TY",I,"T")_" "
38 D DASH^LRX
39 F I=1:1:LRSHD I $D(I(I)) S LRCL=8,LRG=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0) W ! D BS4
40 I $D(LRTX) S LRTX="" W !,"Comments: " F I=1:1 S LRTX=$O(LRTX(LRTX)) Q:LRTX="" W ?(10*LRTX-6),$C(96+I)
41 D TXT1^LRAC9 S LROFDT=LRFDT I $D(LRTX) S LRTX="" F I=1:1 S LRTX=$O(LRTX(LRTX)) Q:LRTX="" S LRFDT=LRTX(LRTX) D:$Y>(IOSL-8) OVFL^LRAC7 W !,$C(96+I),". " D TXT^LRAC9
42 S LRFDT=LROFDT K LRTY,LRTX,^TMP($J,"TY") I 'LRFDT D HEAD1^LRAC6 G LRSH^LRAC3
43 I $O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT))<1 D HEAD1^LRAC6 G LRSH^LRAC3
44 S LRFDT=LRLFDT I LRFULL D HEAD1^LRAC6,HEAD^LRAC6,LRNP^LRAC3 S LRFULL=0,LRMU=0
45 G BS
46IA I $D(DUZ("AG")),$L(DUZ("AG")),"ARMYAFN"[DUZ("AG"),LRDPF=2 S IADA=$P(^LR(LRDFN,0),U,3) I IADA'="",$D(^DPT(IADA,0)) S IAX=LRFDT D ^LRAIRNUM I IARNO'="" S:'$D(IA(0)) IA(0)="INPAT #" S IA(K)=IARNO
47 Q
Note: See TracBrowser for help on using the repository browser.