source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLRK1.m@ 1281

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1SPNLRK1 ;ISC-SF/GB-SCD LAB TEST UTILIZATION REPORT (PART 1 OF 1) ;4 JUNE 94 [ 08/23/94 10:03 AM ]
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3P1(TITLE,PAGELEN,ABORT) ;
4 ; NDTESTS Number of different lab tests
5 ; TESTNR Type of Lab test (lab test number)
6 ; ORDERS Number of orders places
7 N NDTESTS,TESTNR,OUT,LINE,STARTLIN,COL,ORDERS,NPATS,RESULTS
8 S TITLE(4)=""
9 S ORDERS=+$G(^TMP("SPN",$J,"CH","ORDERS"))
10 S RESULTS=+$G(^TMP("SPN",$J,"CH","RESULTS"))
11 S NPATS=+$G(^TMP("SPN",$J,"CH","PAT"))
12 S TITLE(5)=$$CENTER^SPNLRU("Totals: "_$FN(ORDERS,",")_" order"_$S(ORDERS=1:"",1:"s")_" placed ("_$FN(RESULTS,",")_" result"_$S(RESULTS=1:"",1:"s")_" reported) for "_$FN(NPATS,",")_" patient"_$S(NPATS=1:"",1:"s"))
13 S TESTNR=""
14 F NDTESTS=0:1 S TESTNR=$O(^TMP("SPN",$J,"CH","TEST",TESTNR)) Q:TESTNR=""
15 S:NDTESTS=1&(RESULTS>1) TITLE(6)=$$CENTER^SPNLRU("(This includes just one type of lab test)")
16 S:NDTESTS>1 TITLE(6)=$$CENTER^SPNLRU("(These include "_$FN(NDTESTS,",")_" different lab tests)")
17 S ORDERS=+$O(^TMP("SPN",$J,"CH","ORDERS",""))
18 F D Q:ORDERS=""!(ABORT)
19 . D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
20 . K OUT,TITLE(4),TITLE(5),TITLE(6)
21 . S STARTLIN=$Y
22 . S OUT(STARTLIN+1)=""
23 . F COL=1:1:3 D Q:ORDERS=""
24 . . S OUT(STARTLIN)=$G(OUT(STARTLIN))_" Patients Orders "
25 . . F LINE=STARTLIN+2:1:PAGELEN D Q:ORDERS=""
26 . . . S OUT(LINE)=$G(OUT(LINE))_$J($FN($G(^TMP("SPN",$J,"CH","ORDERS",ORDERS)),","),10)_$J($FN(-ORDERS,","),11)_" "
27 . . . S ORDERS=$O(^TMP("SPN",$J,"CH","ORDERS",ORDERS))
28 . S LINE=""
29 . F S LINE=$O(OUT(LINE)) Q:LINE="" D
30 . . W !,OUT(LINE)
31 Q
32P2(TITLE,PAGELEN,QLIST,ABORT) ;
33 N NPATS,TESTNR,RESULTS,MAXPATS,MAXTESTS,NAME
34 S TITLE(4)=""
35 S TITLE(5)=$$CENTER^SPNLRU("Lab Tests with "_$FN(QLIST("MIN"),",")_" or more Results")
36 S TITLE(6)=""
37 ; TITLE(5)=" 1 2 3 4 5 6 7 8"
38 S TITLE(7)=" Max # Results"
39 S TITLE(8)="Lab Test Results Patients (# patients)"
40 D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
41 S TESTNR=""
42 F S TESTNR=$O(^TMP("SPN",$J,"CH","TEST",TESTNR)) Q:TESTNR="" D
43 . S RESULTS=^TMP("SPN",$J,"CH","TEST",TESTNR)
44 . Q:RESULTS<QLIST("MIN")
45 . S NPATS=^TMP("SPN",$J,"CH","TEST",TESTNR,"PAT")
46 . S NAME=^TMP("SPN",$J,"CH","TEST",TESTNR,"NAME")
47 . S ^TMP("SPN",$J,"CH","OUT",-RESULTS,-NPATS,NAME)=TESTNR
48 S RESULTS=""
49 F S RESULTS=$O(^TMP("SPN",$J,"CH","OUT",RESULTS)) Q:RESULTS="" D Q:ABORT
50 . S NPATS=""
51 . F S NPATS=$O(^TMP("SPN",$J,"CH","OUT",RESULTS,NPATS)) Q:NPATS="" D Q:ABORT
52 . . S NAME=""
53 . . F S NAME=$O(^TMP("SPN",$J,"CH","OUT",RESULTS,NPATS,NAME)) Q:NAME="" D Q:ABORT
54 . . . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
55 . . . S TESTNR=^TMP("SPN",$J,"CH","OUT",RESULTS,NPATS,NAME)
56 . . . S MAXTESTS=$O(^TMP("SPN",$J,"CH","TEST",TESTNR,"RESULTS",""))
57 . . . S MAXPATS=^TMP("SPN",$J,"CH","TEST",TESTNR,"RESULTS",MAXTESTS)
58 . . . W !,NAME,?35,$J($FN(-RESULTS,","),11),?50,$J($FN(-NPATS,","),10)
59 . . . I RESULTS'=NPATS&(-RESULTS>1)&(-NPATS>1) W ?65,$J(-MAXTESTS,8)," (",MAXPATS,")"
60 . . . ; See what IMRWRBP does here for national report.
61 K ^TMP("SPN",$J,"CH","OUT"),TITLE(5),TITLE(6),TITLE(7),TITLE(8)
62 Q
63P3(TITLE,PAGELEN,HIUSERS,ABORT) ;
64 ; I High user counter
65 ; PID Patient ID (Coded SSN)
66 ; PNAME Patient Name
67 ; PSSN Patient SSN
68 N RESULTS,NDTESTS,PID,PNAME,PSSN,I,ORDERS
69 ; TITLE(6)=" 1 2 3 4 5 6 7 8"
70 S TITLE(6)=" Different"
71 S TITLE(7)="Patient Name SSN Orders Results Lab Tests"
72 D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
73 S ORDERS=""
74 F I=1:1:HIUSERS S ORDERS=$O(^TMP("SPN",$J,"CH","HI","H1",ORDERS)) Q:ORDERS="" D Q:ABORT
75 . S RESULTS=""
76 . F S RESULTS=$O(^TMP("SPN",$J,"CH","HI","H1",ORDERS,RESULTS)) Q:RESULTS="" D Q:ABORT
77 . . S NDTESTS=""
78 . . F S NDTESTS=$O(^TMP("SPN",$J,"CH","HI","H1",ORDERS,RESULTS,NDTESTS)) Q:NDTESTS="" D Q:ABORT
79 . . . S PID=""
80 . . . F S PID=$O(^TMP("SPN",$J,"CH","HI","H1",ORDERS,RESULTS,NDTESTS,PID)) Q:PID="" D Q:ABORT
81 . . . . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
82 . . . . D GETNAME^SPNLRU(PID,.PNAME,.PSSN)
83 . . . . W !,PNAME,?32,PSSN,?45,$J($FN(-ORDERS,","),6),?55,$J($FN(-RESULTS,","),9),?70,$J(-NDTESTS,8)
84 Q
Note: See TracBrowser for help on using the repository browser.