source: FOIAVistA/tag/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLRM1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1SPNLRM1 ;ISC-SF/GB-SCD RADIOLOGY UTILIZATION REPORT (PRINT PART 1 OF 2) ;5 JUN 94 [ 08/23/94 10:04 AM ]
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3P1(TITLE,PAGELEN,ABORT) ;
4 ; CPTCODE Code of radiology procedure
5 ; NPROCS Number of procedures
6 ; NDPROCS Number of different procedures
7 N NPROCS,NDPROCS,CPTCODE,OUT,LINE,STARTLIN,COL,NPATS
8 S TITLE(4)=""
9 S NPROCS=+$G(^TMP("SPN",$J,"RA","EXAMS"))
10 S NPATS=+$G(^TMP("SPN",$J,"RA","PAT"))
11 S TITLE(5)=$$CENTER^SPNLRU("Totals: "_$FN(NPROCS,",")_" procedure"_$S(NPROCS=1:"",1:"s")_" reported for "_$FN(NPATS,",")_" patient"_$S(NPATS=1:"",1:"s"))
12 S CPTCODE=""
13 F NDPROCS=0:1 S CPTCODE=$O(^TMP("SPN",$J,"RA","PROC",CPTCODE)) Q:CPTCODE=""
14 S:NDPROCS=1&(NPROCS>1) TITLE(6)=$$CENTER^SPNLRU("(This includes just one type of procedure)")
15 S:NDPROCS>1 TITLE(6)=$$CENTER^SPNLRU("(These include "_$FN(NDPROCS,",")_" different procedures)")
16 S NPROCS=+$O(^TMP("SPN",$J,"RA","EXAMS",""))
17 F D Q:NPROCS=""!(ABORT)
18 . D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
19 . K OUT,TITLE(4),TITLE(5),TITLE(6)
20 . S STARTLIN=$Y
21 . S OUT(STARTLIN+1)=""
22 . F COL=1:1:3 D Q:NPROCS=""
23 . . S OUT(STARTLIN)=$G(OUT(STARTLIN))_" Patients Procedures "
24 . . F LINE=STARTLIN+2:1:PAGELEN D Q:NPROCS=""
25 . . . S OUT(LINE)=$G(OUT(LINE))_$J($FN(+$G(^TMP("SPN",$J,"RA","EXAMS",NPROCS)),","),10)_$J($FN(-NPROCS,","),12)_" "
26 . . . S NPROCS=$O(^TMP("SPN",$J,"RA","EXAMS",NPROCS))
27 . S LINE=""
28 . F S LINE=$O(OUT(LINE)) Q:LINE="" D
29 . . W !,OUT(LINE)
30 Q
31P2(TITLE,PAGELEN,QLIST,ABORT) ;
32 N NPATS,NPROCS,CPTCODE,NAME,COST
33 S TITLE(4)=""
34 S TITLE(5)=$$CENTER^SPNLRU($FN(QLIST("MINNUM"),",")_" or More Procedures")
35 S TITLE(6)=""
36 S TITLE(7)="Radiology Procedure CPT Code Procedures Value Patients"
37 D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
38 S CPTCODE=""
39 F S CPTCODE=$O(^TMP("SPN",$J,"RA","PROC",CPTCODE)) Q:CPTCODE="" D
40 . S NPROCS=^TMP("SPN",$J,"RA","PROC",CPTCODE)
41 . Q:NPROCS<QLIST("MINNUM")
42 . S COST=^TMP("SPN",$J,"RA","PROC",CPTCODE,"VAL")
43 . S NPATS=^TMP("SPN",$J,"RA","PROC",CPTCODE,"PAT")
44 . S NAME=^TMP("SPN",$J,"RA","PROC",CPTCODE,"NAME")
45 . S ^TMP("SPN",$J,"RA","OUT",-NPROCS,-COST,-NPATS,NAME)=CPTCODE
46 S NPROCS=""
47 F S NPROCS=$O(^TMP("SPN",$J,"RA","OUT",NPROCS)) Q:NPROCS="" D Q:ABORT
48 . S COST=""
49 . F S COST=$O(^TMP("SPN",$J,"RA","OUT",NPROCS,COST)) Q:COST="" D Q:ABORT
50 . . S NPATS=""
51 . . F S NPATS=$O(^TMP("SPN",$J,"RA","OUT",NPROCS,COST,NPATS)) Q:NPATS="" D Q:ABORT
52 . . . S NAME=""
53 . . . F S NAME=$O(^TMP("SPN",$J,"RA","OUT",NPROCS,COST,NPATS,NAME)) Q:NAME="" D Q:ABORT
54 . . . . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
55 . . . . S CPTCODE=^TMP("SPN",$J,"RA","OUT",NPROCS,COST,NPATS,NAME)
56 . . . . W !,NAME,?39,$S(CPTCODE=0:"",1:$J(CPTCODE,5)),?47,$J($FN(-NPROCS,","),11),?58,$J($FN(-COST,",",2),10),?69,$J($FN(-NPATS,","),10)
57 K ^TMP("SPN",$J,"RA","OUT")
58 K TITLE(4),TITLE(5),TITLE(6),TITLE(7)
59 Q
60P3(TITLE,PAGELEN,QLIST,ABORT) ;
61 N NPATS,NAME,NPROCS,LCOST,TCOST,COST,CPTCODE
62 S TITLE(4)=""
63 S TITLE(5)=$$CENTER^SPNLRU("Radiology procedures totaling $"_$FN(QLIST("MINCOST"),",",2)_" or more")
64 ; TITLE(5)=" 1 2 3 4 5 6 7 8"
65 S TITLE(6)=""
66 S TITLE(7)="Radiology Procedure CPT Code Value Procedures Patients"
67 D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
68 S CPTCODE="",(LCOST,TCOST)=0
69 F S CPTCODE=$O(^TMP("SPN",$J,"RA","PROC",CPTCODE)) Q:CPTCODE="" D
70 . S COST=^TMP("SPN",$J,"RA","PROC",CPTCODE,"VAL")
71 . S TCOST=TCOST+COST
72 . Q:COST<QLIST("MINCOST")
73 . S LCOST=LCOST+COST
74 . S NPROCS=^TMP("SPN",$J,"RA","PROC",CPTCODE)
75 . S NPATS=^TMP("SPN",$J,"RA","PROC",CPTCODE,"PAT")
76 . S NAME=^TMP("SPN",$J,"RA","PROC",CPTCODE,"NAME")
77 . S ^TMP("SPN",$J,"RA","OUT",-COST,-NPROCS,-NPATS,NAME)=CPTCODE
78 S COST=""
79 F S COST=$O(^TMP("SPN",$J,"RA","OUT",COST)) Q:COST="" D Q:ABORT
80 . S NPROCS=""
81 . F S NPROCS=$O(^TMP("SPN",$J,"RA","OUT",COST,NPROCS)) Q:NPROCS="" D Q:ABORT
82 . . S NPATS=""
83 . . F S NPATS=$O(^TMP("SPN",$J,"RA","OUT",COST,NPROCS,NPATS)) Q:NPATS="" D Q:ABORT
84 . . . S NAME=""
85 . . . F S NAME=$O(^TMP("SPN",$J,"RA","OUT",COST,NPROCS,NPATS,NAME)) Q:NAME="" D Q:ABORT
86 . . . . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
87 . . . . S CPTCODE=^TMP("SPN",$J,"RA","OUT",COST,NPROCS,NPATS,NAME)
88 . . . . W !,NAME,?39,$S(CPTCODE=0:"",1:$J(CPTCODE,5)),?45,$J($FN(-COST,",",2),11),?57,$J($FN(-NPROCS,","),11),?68,$J($FN(-NPATS,","),11)
89 K ^TMP("SPN",$J,"RA","OUT")
90 I TCOST=LCOST D
91 . I $Y+1>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
92 . W !!,"TOTAL for all procedures",?45,$J($FN(TCOST,",",2),11)
93 E D
94 . I $Y+2>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
95 . W !!,"TOTAL for listed procedures",?45,$J($FN(LCOST,",",2),11)
96 . W !,"TOTAL (including unlisted procedures)",?45,$J($FN(TCOST,",",2),11)
97 K TITLE(4),TITLE(5),TITLE(6),TITLE(7)
98 Q
Note: See TracBrowser for help on using the repository browser.