| 1 | LR7OGMC ;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 | ; | 
|---|
| 13 | CH(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 | ; | 
|---|
| 36 | CHSETUP ; 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 | 
|---|
| 61 | RS(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 | 
|---|