| 1 | SPNLGECH ; ISC-SF/GMB - SCD GATHER LAB TEST (GENERAL) DATA;11 MAY 94 [ 07/06/94 9:57 AM ] ;6/23/95 11:18
|
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|---|
| 3 | EXTRACT(DFN,FDATE,TDATE,CLEARTXT,ABORT) ;
|
|---|
| 4 | ; DFN Patient's internal entry number in the Patient file
|
|---|
| 5 | ; FDATE "From" date
|
|---|
| 6 | ; TDATE "Thru" date, default=today
|
|---|
| 7 | ; CLEARTXT 1=translate all codes to their meaning,
|
|---|
| 8 | ; 0=don't translate codes (default=0)
|
|---|
| 9 | N LFN,LASTDATE,TESTDATE,TESTNR,VALUE,REALDATE,YYY,MM,TESTNAME,TESTCOST
|
|---|
| 10 | S LFN=+$P($G(^DPT(DFN,"LR")),U,1) ; Internal entry number in LAB DATA file
|
|---|
| 11 | Q:'LFN
|
|---|
| 12 | I '$D(TDATE) S TDATE=DT
|
|---|
| 13 | I '$D(CLEARTXT) S CLEARTXT=0
|
|---|
| 14 | ; We change the days in the dates, because we track only whole months'
|
|---|
| 15 | ; worth of data.
|
|---|
| 16 | S FDATE=$E(FDATE,1,5)_"01"
|
|---|
| 17 | S TDATE=$E(TDATE,1,5)_"31"
|
|---|
| 18 | ; We are interested in any lab test administered within the 'from' and
|
|---|
| 19 | ; 'thru' date range. The record numbers are date/time (of test),
|
|---|
| 20 | ; subtracted from 9999999. This causes the tests to be listed in order
|
|---|
| 21 | ; from most recent to oldest. So we must modify our from & to dates.
|
|---|
| 22 | K ^TMP("SPN",$J,"CH")
|
|---|
| 23 | S LASTDATE=9999999-FDATE
|
|---|
| 24 | S TESTDATE=9999999-(TDATE+1) ; for each test date in the range
|
|---|
| 25 | F S TESTDATE=$O(^LR(LFN,"CH",TESTDATE)) Q:TESTDATE'>0!(TESTDATE>LASTDATE) D
|
|---|
| 26 | . S REALDATE=9999999-TESTDATE\1
|
|---|
| 27 | . S YYY=$E(REALDATE,1,3)
|
|---|
| 28 | . S MM=+$E(REALDATE,4,5)
|
|---|
| 29 | . S TESTNR=1 ; for each test on that date
|
|---|
| 30 | . ; we start after 1 because the first two (0,1) nodes we ignore.
|
|---|
| 31 | . ; Each node thereafter is for a specific test.
|
|---|
| 32 | . F S TESTNR=$O(^LR(LFN,"CH",TESTDATE,TESTNR)) Q:TESTNR'>0 D
|
|---|
| 33 | . . S VALUE=$G(^LR(LFN,"CH",TESTDATE,TESTNR))
|
|---|
| 34 | . . ; make sure the test wasn't cancelled
|
|---|
| 35 | . . I VALUE=""!(VALUE["canc")!(VALUE["CANC") Q
|
|---|
| 36 | . . ; now we increment a count of the number of times this test was
|
|---|
| 37 | . . ; given in this month of this year
|
|---|
| 38 | . . S $P(^(YYY),U,MM)=$P($G(^TMP("SPN",$J,"CH",TESTNR,YYY)),U,MM)+1
|
|---|
| 39 | S TESTNR=""
|
|---|
| 40 | F S TESTNR=$O(^TMP("SPN",$J,"CH",TESTNR)) Q:TESTNR="" D
|
|---|
| 41 | . ; Get the name from the DD. Is there a better way?
|
|---|
| 42 | . ; If the name is so firm, why are we sending it?
|
|---|
| 43 | . S TESTNAME=$P($G(^DD(63.04,TESTNR,0)),U,1)
|
|---|
| 44 | . ; We might also use $O(^LAB(60,"B",TESTNAME,0)) in the following...
|
|---|
| 45 | . ; I think either should work fine.
|
|---|
| 46 | . S TESTCOST=$P($G(^LAB(60,+$O(^LAB(60,"C","CH;"_TESTNR_";1",0)),0)),U,11)
|
|---|
| 47 | . S YYY=""
|
|---|
| 48 | . F S YYY=$O(^TMP("SPN",$J,"CH",TESTNR,YYY)) Q:YYY="" D
|
|---|
| 49 | . . D ADDREC^SPNLGE("CH",YYY_"0000"_"^"_TESTNAME_"^"_TESTNR_"^"_TESTCOST_"^"_^TMP("SPN",$J,"CH",TESTNR,YYY))
|
|---|
| 50 | K ^TMP("SPN",$J,"CH")
|
|---|
| 51 | Q
|
|---|
