source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OSUM4.m@ 1489

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1LR7OSUM4 ;slc/dcm - Silent Patient cum cont. ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,228,241,251**;Sep 27, 1994
3BS ;from LR7OSUM3
4 K I,^TMP($J,"TY")
5 S LRCW=10,LRHI="",LRLO="",LRTT=1,I=0,LRTY=GIOM-20\10,LRMU=LRMU+1,LRII=0
6 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
7 K P3,P6
8 F K=1:1:(LRTY-1) S LRFDT=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT)) Q:LRFDT<1 S Z=^(LRFDT,0),^TMP($J,"TY",K,"L")=$P(Z,U,1),LRTT=LRTT+1 S:LRFDT>LRLFDT LRLFDT=LRFDT D UDT^LR7OSUM3 D BS1
9 S:LRTT>(LRTY-1)&(LRMULT=1) LRFULL=1
10 S:LRTT>(LRTY-1)&(LRMU=(LRMULT-1)) LRFULL=1
11 F I=1:1:LRSHD D LRLO^LR7OSUM5 S:$L(LRLOHI) ^TMP($J,"TY",(LRTT+1),I)=LRLOHI S:$L(P7) ^TMP($J,"TY",LRTT,I)=P7
12 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)=""
13 D LINE
14 D LN
15 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$E(LRTOPP,1,7))
16 F I=1:1:(LRTT+1) S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(I*10-4,CCNT,$J(^TMP($J,"TY",I,0),10))
17 D LN
18 S XZ="",$P(XZ," ",3)="",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,XZ)
19 F I=1:1:(LRTT-1) S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(I*10-4,CCNT,$J(^TMP($J,"Y2K",I),10))
20 D LN
21 S XZ="",$P(XZ," ",3)="",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,XZ)
22 F I=1:1:(LRTT+1) S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(I*10-4,CCNT,$J(^TMP($J,"TY",I,"T"),10))
23 D LN
24 S XZ="",$P(XZ,"-",GIOM)="",^TMP("LRC",$J,GCNT,0)=XZ
25 F I=1:1:LRSHD S LRCL=8,LRG=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0) D LN S ^TMP("LRC",$J,GCNT,0)="" D BS4
26 I $D(LRTX) D LN S LRTX="",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Comments: ") F I=1:1 S LRTX=$O(LRTX(LRTX)) Q:LRTX="" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(10*LRTX-6,CCNT,$C(96+(I#26))_$S(I\26>0:I\26,1:""))
27 D TXT1^LR7OSUM5
28 S LROFDT=LRFDT
29 I $D(LRTX) S LRTX="" F I=1:1 S LRTX=$O(LRTX(LRTX)) Q:LRTX="" D LN S LRFDT=LRTX(LRTX),^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$C(96+(I#26))_$S(I\26>0:I\26,1:"")_". ") D TXT^LR7OSUM5
30 S LRFDT=LROFDT
31 K LRTY,LRTX,^TMP($J,"TY")
32 I 'LRFDT G LRSH^LR7OSUM3
33 I $O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT))="" G LRSH^LR7OSUM3
34 S LRFDT=LRLFDT
35 I LRFULL D HEAD^LR7OSUM6,LRNP^LR7OSUM3 S LRFULL=0,LRMU=0
36 G BS
37BS1 ;
38 S ^TMP($J,"TY",K,0)=$P(LRUDT," ",1),^TMP($J,"TY",K,"T")=$P(LRUDT," ",2),^TMP($J,"Y2K",K)=$E($P($P($$Y2K^LRX(9999999-LRFDT),"."),"/",3),1,4)
39 F J=1:1:LRSHD S:$D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(J))) ^TMP($J,"TY",K,J)=^(I(J)) S:$D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX"))&'$D(LRTX(LRTT)) LRTX(LRTT)=LRFDT
40 Q
41BS2 ;
42 S X=$S($D(^TMP($J,"TY",J,I)):$P(^(I),U,1),1:""),X1=$S($L(X):$P(^TMP($J,"TY",J,I),U,2),1:""),LRDP=$S($D(^TMP($J,"TY",I,"D")):^("D"),1:""),LRCL=LRCL+10
43 K T1,T3
44 Q
45BS4 F J=0:1:(LRTT+1) S XZ="",$P(XZ," ",LRCL)="" D
46 . I J=0 S X=^TMP($J,"TY",J,I),^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(J*10,CCNT,X) S:'$P($G(^TMP("LRT",$J,X)),"^",2) $P(^TMP("LRT",$J,X),"^",2)=GCNT
47 . I J>0 D
48 .. D BS2
49 .. I $L(X) S LRCW=10 D C1^LR7OSUM5(.X,.X1) S:$L($P(LRG,U,4))&(J<LRTT) @("X="_$P(LRG,"^",4)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(J*10-2,CCNT,X_X1) D
50 ... S:'$L($P(LRG,U,4))!(J'<LRTT) ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(J*10-2,CCNT,$J(X,LRCW))
51 Q
52LN ;Increment the counter
53 S GCNT=GCNT+1,CCNT=1
54 Q
55LINE ;Fill in the global with bank lines
56 N X
57 D LN
58 S X="",$P(X," ",GIOM)="",^TMP("LRC",$J,GCNT,0)=X
59 Q
Note: See TracBrowser for help on using the repository browser.