source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGMC.m@ 1061

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

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1LR7OGMC ;DALOI/STAFF- Interim report rpc memo chem ; Aug 16, 2004
2 ;;5.2;LAB SERVICE;**187,230,312,286,356**;Sep 27, 1994;Build 8
3 ;
4 ; sets lab data into ^TMP("LR7OG",$J,"TP"
5 ; ^TMP("LR7OG",$J,"G")=dfn^pnm^lrdfn^age^sex^lrcw
6 ; ^TMP("LR7OG",$J,"TMP",test subscript in data)=zero node of test
7 ; ^TMP("LR7OG",$J,"TP",collect date/time)=zero node from data
8 ; ^TMP("LR7OG",$J,"TP",collect date/time,printorder)=test#^name^printname^^printcode^dataname^result^flag^units^range^performing site
9 ; ^TMP("LR7OG",$J,"TP",collect date/time,printorder,#)=interpretation
10 ; ^TMP("LR7OG",$J,"TP",collect date/time,"C",#)=comment
11 ;
12 ;
13CH(LRDFN,IDT,ALL,OUTCNT,FORMAT,DONE) ; from LR7OGM
14 N CDT,CHSUB,CMNT,INTP,LABSUB,PNODE,PORDER,SPEC,TCNT,TESTNUM,TESTSUB,ZERO
15 S ZERO=$G(^LR(LRDFN,"CH",IDT,0))
16 I '$P(ZERO,U,3) Q
17 S CDT=+ZERO,LABSUB="CH",TCNT=0,SPEC=$P(ZERO,U,5)
18 S CHSUB=1
19 F S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB="" I ALL!$D(^TMP("LR7OG",$J,"TMP",CHSUB)) D Q
20 . I FORMAT D
21 .. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^CH^"_(9999999-IDT)
22 .. S OUTCNT=OUTCNT+1
23 .. S DONE=1
24 . K ^TMP("LR7OG",$J,"TP")
25 . I ALL S TESTSUB=1 F S TESTSUB=$O(^LR(LRDFN,"CH",IDT,TESTSUB)) Q:TESTSUB<1 S TESTNUM=$O(^LAB(60,"C","CH;"_TESTSUB_";1",0)) D CHSETUP
26 . I 'ALL S TESTSUB=1 F S TESTSUB=$O(^TMP("LR7OG",$J,"TMP",TESTSUB)) Q:TESTSUB<1 S TESTNUM=+^(TESTSUB) D CHSETUP
27 . I TCNT D
28 .. S ^TMP("LR7OG",$J,"TP",CDT)=ZERO,CMNT=0
29 .. F S CMNT=+$O(^LR(LRDFN,LABSUB,IDT,1,CMNT)) Q:CMNT<1 S ^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)=^(CMNT,0) S TCNT=TCNT+1
30 . I FORMAT D GRID^LR7OGMG(.OUTCNT)
31 . I 'FORMAT D PRINT^LR7OGMP(.OUTCNT)
32 . K ^TMP("LR7OG",$J,"TP")
33 Q
34 ;
35 ;
36CHSETUP ; within scope of CH
37 ;
38 N LRX
39 I 'TESTNUM Q
40 Q:'$D(^LAB(60,TESTNUM,.1)) S PNODE=^(.1) I '("BO"[$P($G(^(0)),U,3)) Q
41 Q:'$D(^LR(LRDFN,LABSUB,IDT,TESTSUB)) Q:'$L($P(^(TESTSUB),U))
42 ;
43 S PORDER=$P(PNODE,U,6),PORDER=$S(PORDER:PORDER,1:TESTSUB/1000000)
44 F Q:'$D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:TESTNUM=+^(PORDER) S PORDER=PORDER+1
45 ;
46 I $D(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q
47 ;
48 S LRX=$$TSTRES^LRRPU(LRDFN,LABSUB,IDT,TESTSUB,TESTNUM)
49 S ^TMP("LR7OG",$J,"TP",CDT,PORDER)=TESTNUM_U_$P(^LAB(60,TESTNUM,0),U)_U_$P(PNODE,U)_U_$P(PNODE,U,2)_U_$P(PNODE,U,3)_U_$P(^(0),U,5)_U_$P(LRX,U)_U_$P(LRX,U,2)_U_$P(LRX,U,5)_U_$$RS($P(LRX,U,3),$P(LRX,U,4))_U_$P(LRX,U,6)
50 ;
51 ; Save performing lab ien in list
52 I $P(LRX,U,6) S ^TMP("LRPLS",$J,$P(LRX,U,6))=""
53 ;
54 S TCNT=TCNT+1
55 I $D(^LAB(60,TESTNUM,1,SPEC,1,0)) D
56 . S INTP=0
57 . F S INTP=+$O(^LAB(60,TESTNUM,1,SPEC,1,INTP)) Q:INTP<1 D
58 . . S ^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)=^(INTP,0)
59 . . S TCNT=TCNT+1
60 Q
61RS(RLV,RHV) ;Range Set - Added to support LR*5.2*356
62 ;RLV - Reference Range Low Value contained in the third piece of variable LRX : $P(LRX,U,3)
63 ;RHV - Referance Range High Value contained in the forth piece of variable LRX : $P(LRX,U,4)
64 I RLV="",RHV="" Q RLV
65 I RLV'="",RHV="" S RLV=$S(RLV?.AP:RLV,1:"low: "_RLV) Q RLV
66 I RLV="",RHV'="" S RHV=$S(RHV?.AP:RHV,1:"high: "_RHV) Q RHV
67 Q RLV_" to "_RHV
Note: See TracBrowser for help on using the repository browser.