source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGRCH.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1SPNLGRCH ; ISC-SF/GMB - SCD GATHER LAB TEST (GENERAL) DATA;19 MAY 94 [ 08/23/94 10:03 AM ] ;6/23/95 11:33
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3ROLLUP(DFN,FDATE,TDATE,HI) ;
4 ; DFN Patient's internal entry number in the Patient file
5 ; FDATE "From" date
6 ; TDATE "Thru" date, default=today
7 ; HI 1=keep track of individual patient usage
8 ; 0=don't keep track
9 ; Data will be rolled up into the following global:
10 ; ^TMP("SPN",$J,"CH",
11 ; with the following nodes:
12 ; "PAT") # patients with at least 1 order
13 ; "ORDERS") # orders
14 ; "ORDERS",-orders) # patients who had this many orders
15 ; "RESULTS") # test results
16 ; "RESULTS",-results) # patients who had this many test results
17 ; "TEST",testnr) # results for this test
18 ; "TEST",testnr,"NAME") the name of the test
19 ; "TEST",testnr,"PAT") # patients who had this test
20 ; "TEST",testnr,"RESULTS",-results) # patients who had this many results for this test
21 ; ... and usage by individual patient
22 ; "HI","H1",-orders,-results,-diff tests,DFN)
23 N LFN,LASTDATE,TESTDATE,TESTNR,VALUE,ORDERS
24 N TRESULTS,RESULTS,TEST,NDTESTS
25 S LFN=+$P($G(^DPT(DFN,"LR")),U,1) ; Internal entry number in LAB DATA file
26 Q:'LFN
27 I '$D(TDATE) S TDATE=DT
28 ; We are interested in any lab test administered within the 'from' and
29 ; 'thru' date range. The record numbers are date/time (of test),
30 ; subtracted from 9999999. This causes the tests to be listed in order
31 ; from most recent to oldest. So we must modify our from & to dates.
32 S (ORDERS,TRESULTS)=0
33 S LASTDATE=9999999-FDATE
34 S TESTDATE=9999999-(TDATE+1) ; for each test date in the range
35 F S TESTDATE=$O(^LR(LFN,"CH",TESTDATE)) Q:TESTDATE'>0!(TESTDATE>LASTDATE) D
36 . S RESULTS=0
37 . S TESTNR=1 ; for each test on that date
38 . ; we start after 1 because the first two (0,1) nodes we ignore.
39 . ; Each node thereafter is for a specific test.
40 . F S TESTNR=$O(^LR(LFN,"CH",TESTDATE,TESTNR)) Q:TESTNR'>0 D
41 . . S VALUE=$G(^LR(LFN,"CH",TESTDATE,TESTNR))
42 . . ; make sure the test wasn't cancelled
43 . . I VALUE=""!(VALUE["canc")!(VALUE["CANC") Q
44 . . S TEST(TESTNR)=$G(TEST(TESTNR))+1 ; number results for this test
45 . . S RESULTS=RESULTS+1
46 . Q:RESULTS=0
47 . S TRESULTS=TRESULTS+RESULTS
48 . S ORDERS=ORDERS+1
49 Q:ORDERS=0
50 S ^(-ORDERS)=$G(^TMP("SPN",$J,"CH","ORDERS",-ORDERS))+1
51 S ^("PAT")=$G(^TMP("SPN",$J,"CH","PAT"))+1
52 S ^("RESULTS")=$G(^TMP("SPN",$J,"CH","RESULTS"))+TRESULTS
53 S ^(-TRESULTS)=$G(^TMP("SPN",$J,"CH","RESULTS",-TRESULTS))+1
54 S ^("ORDERS")=$G(^TMP("SPN",$J,"CH","ORDERS"))+ORDERS
55 S TESTNR="",NDTESTS=0
56 F S TESTNR=$O(TEST(TESTNR)) Q:TESTNR="" D
57 . S NDTESTS=NDTESTS+1 ; number of different tests
58 . S RESULTS=TEST(TESTNR)
59 . S ^(TESTNR)=$G(^TMP("SPN",$J,"CH","TEST",TESTNR))+RESULTS
60 . S ^("PAT")=$G(^TMP("SPN",$J,"CH","TEST",TESTNR,"PAT"))+1
61 . S ^(-RESULTS)=$G(^TMP("SPN",$J,"CH","TEST",TESTNR,"RESULTS",-RESULTS))+1
62 Q:'HI
63 S ^TMP("SPN",$J,"CH","HI","H1",-ORDERS,-TRESULTS,-NDTESTS,DFN)=""
64 Q
65NAMEIT ;
66 N TESTNR,TESTNAME
67 S TESTNR=""
68 F S TESTNR=$O(^TMP("SPN",$J,"CH","TEST",TESTNR)) Q:TESTNR="" D
69 . ; Get the name from the DD. Is there a better way?
70 . S TESTNAME=$P($G(^DD(63.04,TESTNR,0)),U,1)
71 . I TESTNAME="" S TESTNAME="Not Identified"
72 . S ^TMP("SPN",$J,"CH","TEST",TESTNR,"NAME")=TESTNAME
73 Q
Note: See TracBrowser for help on using the repository browser.