1 | GMTSLRSC ; SLC/JER,KER - Sel Cum Lab Comp w/Sel Items ; 01/06/2003
|
---|
2 | ;;2.7;Health Summary;**28,47,58**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10035 ^DPT(
|
---|
6 | ; DBIA 67 ^LAB(60
|
---|
7 | ; DBIA 525 ^LR(
|
---|
8 | ;
|
---|
9 | MAIN ; Selected Cumulative Lab w/Selection Items
|
---|
10 | N GMTSI,LRDFN,MAX,TEST,RWIDTH,GMCMNT,COMMNBR,GMCOM,TAB
|
---|
11 | S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999) Q:'$D(^DPT(DFN,"LR"))
|
---|
12 | Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR") Q:'$D(^LR(LRDFN)) Q:'$O(GMTSEG(GMTSEGN,60,0))
|
---|
13 | S RWIDTH=4,GMTSI=0 F S GMTSI=$O(GMTSEG(GMTSEGN,60,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
|
---|
14 | . S TEST=GMTSEG(GMTSEGN,60,GMTSI) D ^GMTSLRSE
|
---|
15 | Q:'$D(^TMP("LRS",$J)) S GMCMNT=$S($P($G(^GMT(142.99,1,0)),U,3)="Y":1,1:0),COMMNBR=0
|
---|
16 | F D DISPLAY Q:$O(^TMP("LRS",$J,0))'>0 Q:$D(GMTSQIT)
|
---|
17 | I GMCMNT,'$D(GMTSQIT) D WRTCOMM
|
---|
18 | K ^TMP("LRS",$J),^TMP("LRSR",$J)
|
---|
19 | Q
|
---|
20 | DISPLAY ; Displays up to 7 tests across page
|
---|
21 | N GMC,GMN,GMI,GMW,GMX,HDR,TST,IT,IX,MORE,RES
|
---|
22 | D INVRT Q:$D(GMTSQIT) S IT="" F GMI=0:1:6 S IT=$O(^TMP("LRS",$J,IT)) Q:'IT D
|
---|
23 | . S IX="" F S IX=$O(^(IT,IX)) Q:IX'>0 D
|
---|
24 | . . S TST=+$P(^(IX),U,3),HDR(GMI)=$S(TST'="":$E($P($G(^LAB(60,TST,.1)),U),1,7),1:"")
|
---|
25 | . . K ^TMP("LRS",$J,IT)
|
---|
26 | D WRTHDR S RES=$$RES,MORE=$S(+($G(RES))>+($G(MAX)):1,1:0)
|
---|
27 | S IX="" F GMW=1:1:MAX S IX=$O(^TMP("LRSR",$J,IX)) Q:+IX'>0 D Q:$D(GMTSQIT)
|
---|
28 | . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG WRTHDR
|
---|
29 | . S IT="" F GMI=0:1 S IT=$O(^TMP("LRSR",$J,IX,IT)) Q:IT="" D Q:$D(GMTSQIT)
|
---|
30 | . . D WRT I '$O(^TMP("LRSR",$J,IX,IT)) W !
|
---|
31 | I '$D(GMTSOBJ),+($G(MORE)) D
|
---|
32 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
33 | . W $C(7),!?10,"** Additional Results available outside occurrence limit **",!
|
---|
34 | K ^TMP("LRSR",$J) W:$D(^TMP("LRS",$J)) !
|
---|
35 | Q
|
---|
36 | WRTHDR ; Writes Column Header
|
---|
37 | N GMI
|
---|
38 | D CKP^GMTSUP Q:$D(GMTSQIT) W "Collection DT"
|
---|
39 | W ?19,$S(+$G(GMCMNT):" ",1:""),"Spec"
|
---|
40 | F GMI=0:1:6 D CKP^GMTSUP Q:'$D(HDR(GMI))!($D(GMTSQIT)) W ?(((8*GMI+25)+(7-$L(HDR(GMI))\2))),$E(HDR(GMI),1,7)
|
---|
41 | D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
42 | I '$D(GMTSOBJ) D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
43 | Q
|
---|
44 | WRT ; Writes the Lab Record
|
---|
45 | S GMX=^TMP("LRSR",$J,IX,IT),TAB=$P(GMX,U)
|
---|
46 | I GMI=0!(GMTSNPG) D
|
---|
47 | . I +$G(GMCMNT),$D(^TMP("LRS",$J,"C",IX))>0,$D(GMCOM("DT",IX))'>0,COMMNBR<26 D
|
---|
48 | . . S GMLTR=$C(97+COMMNBR) S COMMNBR=COMMNBR+1
|
---|
49 | . . S GMCOM("DT",IX)=GMLTR,GMCOM("LTR",GMLTR)=IX
|
---|
50 | . I +$G(GMCMNT) D Q
|
---|
51 | . . W $E($G(GMCOM("DT",IX)),1),?2,$P(GMX,U,2),?19,$E($P($P(GMX,U,3),";",2),1,5)
|
---|
52 | . W $P(GMX,U,2),?19,$E($P($P(GMX,U,3),";",2),1,5)
|
---|
53 | W ?(8*TAB+25),$P(GMX,U,4)," ",$P(GMX,U,5)
|
---|
54 | Q
|
---|
55 | WRTCOMM ; Writes the lab Comments
|
---|
56 | N GMLTR,GMLINE
|
---|
57 | Q:$D(GMCOM)'>0
|
---|
58 | D CKP^GMTSUP Q:$D(GMTSQIT) W "COMMENTS:",!
|
---|
59 | S GMLTR=""
|
---|
60 | F S GMLTR=$O(GMCOM("LTR",GMLTR)) Q:GMLTR']"" D Q:$D(GMTSQIT)
|
---|
61 | . S IX=$G(GMCOM("LTR",GMLTR)),GMLINE=0
|
---|
62 | . F S GMLINE=$O(^TMP("LRS",$J,"C",+IX,GMLINE)) Q:GMLINE'>0 D Q:$D(GMTSQIT)
|
---|
63 | . . D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W "COMMENTS:",!
|
---|
64 | . . W:GMLINE=1!GMTSNPG GMLTR_"."
|
---|
65 | . . W ?3,$G(^TMP("LRS",$J,"C",+IX,GMLINE)),!
|
---|
66 | Q
|
---|
67 | ;
|
---|
68 | RES(X) ; Results
|
---|
69 | N NN,NC S X=0,NN="^TMP(""LRSR"","_$J_")",NC="^TMP(""LRSR"","_$J_","
|
---|
70 | F S NN=$Q(@NN) Q:NN=""!(NN'[NC) S X=X+1
|
---|
71 | Q X
|
---|
72 | INVRT ; Inverts Global Array
|
---|
73 | ;
|
---|
74 | ; From: ^TMP("LRS",$J,IT,IX)=CDT^SPC^TNM^RSLT^FLAG^UNIT^LO^HI
|
---|
75 | ; To: ^TMP("LRSR",$J,IX,IT)=GMI,CDT,SPC,RSLT,FLAG
|
---|
76 | ;
|
---|
77 | N GMI,IT,IX
|
---|
78 | S IT=""
|
---|
79 | F GMI=0:1:6 S IT=$O(^TMP("LRS",$J,IT)) Q:IT'>0 D
|
---|
80 | . S IX="" F S IX=$O(^TMP("LRS",$J,IT,IX)) Q:IX="" D
|
---|
81 | . . S ^TMP("LRSR",$J,IX,IT)=GMI_U_$P(^TMP("LRS",$J,IT,IX),U,1,2)_U_$P(^TMP("LRS",$J,IT,IX),U,4,5)
|
---|
82 | Q
|
---|