source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLRR1.m@ 674

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1SPNLRR1 ;ISC-SF/GB-SCD LAB TEST UTILIZATION (SPECIFIC) REPORT (PART 1 OF 1) ;9/1/95 08:23
2 ;;2.0;Spinal Cord Dysfunction;**20**;01/02/1997
3P1(TITLE,PAGELEN,QLIST,ABORT) ;
4 ; PID Patient Name
5 ; PSSN Patient SSN
6 N NPATS,TESTNR,RESULTS,LABTEST,TESTNAME,PID,PNAME,PSSN
7 S TITLE(4)=""
8 S TITLE(7)=""
9 ; TITLE(7)=" 1 2 3 4 5 6 7 8"
10 S TITLE(8)="Patient Name SSN Tests"
11 S TESTNR="" ; create list in test name order
12 F S TESTNR=$O(QLIST(TESTNR)) Q:TESTNR="" D
13 . S LABTEST(QLIST(TESTNR))=TESTNR
14 S TESTNAME=""
15 F S TESTNAME=$O(LABTEST(TESTNAME)) Q:TESTNAME="" D Q:ABORT
16 . S TITLE(5)=$$CENTER^SPNLRU(TESTNAME)
17 . S TESTNR=LABTEST(TESTNAME)
18 . S RESULTS=+$G(^TMP("SPN",$J,"CH","TEST",TESTNR))
19 . S NPATS=+$G(^TMP("SPN",$J,"CH","TEST",TESTNR,"PAT"))
20 . S TITLE(6)=$$PAD^SPNLRU("Total: "_$FN(NPATS,",")_" patient"_$S(NPATS=1:"",1:"s"),50)_$J($FN(RESULTS,","),12)
21 . D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
22 . K TITLE(6)
23 . S PID=""
24 . F S PID=$O(^TMP("SPN",$J,"CH","TEST",TESTNR,"PID",PID)) Q:(PID="")!(ABORT=1) D
25 . . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
26 . . S PNAME=$P(PID,U,1),PSSN=$P(PID,U,2)
27 . . S RESULTS=+$G(^TMP("SPN",$J,"CH","TEST",TESTNR,"PID",PID))
28 . . W !,PNAME,?32,PSSN,?50,$J($FN(RESULTS,","),11)
29 K TITLE(4),TITLE(5),TITLE(7),TITLE(8)
30 Q
31P2(TITLE,PAGELEN,QLIST,ABORT) ;
32 N NPATS,TESTNR,RESULTS,LABTEST,TESTNAME
33 S TITLE(4)=""
34 ; TITLE(5)=" 1 2 3 4 5 6 7 8"
35 S TITLE(5)="Lab Test Patients Results"
36 S TESTNR="" ; create list in test name order
37 F S TESTNR=$O(QLIST(TESTNR)) Q:TESTNR="" D
38 . S LABTEST(QLIST(TESTNR))=TESTNR
39 D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
40 S TESTNAME=""
41 F S TESTNAME=$O(LABTEST(TESTNAME)) Q:TESTNAME="" D
42 . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
43 . S TESTNR=LABTEST(TESTNAME)
44 . S RESULTS=+$G(^TMP("SPN",$J,"CH","TEST",TESTNR))
45 . S NPATS=+$G(^TMP("SPN",$J,"CH","TEST",TESTNR,"PAT"))
46 . W !,TESTNAME,?31,$J($FN(NPATS,","),11),?48,$J($FN(RESULTS,","),11)
47 K TITLE(4),TITLE(5)
48 Q
Note: See TracBrowser for help on using the repository browser.