source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLRL2.m@ 1352

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1SPNLRL2 ;ISC-SF/GB-SCD PHARMACY UTILIZATION REPORT (PRINT PART 2 OF 3) ;5 JUN 94 [ 08/23/94 10:04 AM ]
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ; PAGELEN Number of lines per page
4 ; TITLE Array of header lines (titles)
5P3(TITLE,PAGELEN,QLIST,ABORT) ;
6 N NPATS,ZDRUGNR,NAME,FILLS,LCOST,TCOST,COST,QTY,COSTITLE,COSTNODE
7 I QLIST("COST")="ACTUAL" D
8 . S COSTITLE(1)=" Actual"
9 . S COSTITLE(2)=" Cost "
10 . S COSTNODE="COST"
11 E D
12 . S COSTITLE(1)="Current"
13 . S COSTITLE(2)=" Value "
14 . S COSTNODE="VAL"
15 S TITLE(4)=""
16 S TITLE(5)=$$CENTER^SPNLRU("Drugs with fills totaling $"_$FN(QLIST("MINCOST"),",",2)_" or more")
17 ; TITLE(5)=" 1 2 3 4 " " 5 6 7 8"
18 S TITLE(6)=""
19 S TITLE(7)=" "_COSTITLE(1)_" Qty"
20 S TITLE(8)="Drug "_COSTITLE(2)_" Fills Disp Pats"
21 D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
22 S ZDRUGNR="",(LCOST,TCOST)=0
23 F S ZDRUGNR=$O(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR)) Q:ZDRUGNR="" D
24 . S COST=^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,COSTNODE)
25 . S TCOST=TCOST+COST
26 . Q:COST<QLIST("MINCOST")
27 . S LCOST=LCOST+COST
28 . S FILLS=^TMP("SPN",$J,"RX","DRUG",ZDRUGNR)
29 . S NPATS=^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"PAT")
30 . S QTY=^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"QTY")
31 . S NAME=^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"NAME")
32 . S ^TMP("SPN",$J,"RX","OUT",-COST,-FILLS,-QTY,-NPATS,NAME)=""
33 S COST=""
34 F S COST=$O(^TMP("SPN",$J,"RX","OUT",COST)) Q:COST="" D Q:ABORT
35 . S FILLS=""
36 . F S FILLS=$O(^TMP("SPN",$J,"RX","OUT",COST,FILLS)) Q:FILLS="" D Q:ABORT
37 . . S QTY=""
38 . . F S QTY=$O(^TMP("SPN",$J,"RX","OUT",COST,FILLS,QTY)) Q:QTY="" D Q:ABORT
39 . . . S NPATS=""
40 . . . F S NPATS=$O(^TMP("SPN",$J,"RX","OUT",COST,FILLS,QTY,NPATS)) Q:NPATS="" D Q:ABORT
41 . . . . S NAME=""
42 . . . . F S NAME=$O(^TMP("SPN",$J,"RX","OUT",COST,FILLS,QTY,NPATS,NAME)) Q:NAME="" D Q:ABORT
43 . . . . . I $Y>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
44 . . . . . W !,NAME,?40,$J($FN(-COST,",",2),14),?54,$J($FN(-FILLS,","),9),?64,$J($FN(-QTY,","),9),?73,$J($FN(-NPATS,","),7)
45 K ^TMP("SPN",$J,"RX","OUT")
46 I TCOST=LCOST D
47 . I $Y+1>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
48 . W !!,"TOTAL for all drugs",?40,$J($FN(TCOST,",",2),14)
49 E D
50 . I $Y+2>PAGELEN D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
51 . W !!,"TOTAL for listed drugs",?40,$J($FN(LCOST,",",2),14)
52 . W !,"TOTAL (including unlisted drugs)",?40,$J($FN(TCOST,",",2),14)
53 K TITLE(4),TITLE(5),TITLE(6),TITLE(7),TITLE(8)
54 Q
55P4(TITLE,PAGELEN,QLIST,ABORT) ;
56 N COST,JD,OUT,LINE,STARTLIN,COL,COSTITLE,COSTNODE
57 I QLIST("COST")="ACTUAL" D
58 . S COSTITLE=" Dollar Cost "
59 . S COSTNODE="COST"
60 E D
61 . S COSTITLE=" Dollar Value "
62 . S COSTNODE="VAL"
63 S COST=+$O(^TMP("SPN",$J,"RX",COSTNODE,""))
64 F D Q:COST=""!(ABORT)
65 . D HEADER^SPNLRU(.TITLE,.ABORT) Q:ABORT
66 . S STARTLIN=$Y
67 . K OUT
68 . S OUT(STARTLIN+2)=""
69 . F COL=1:1:3 D Q:COST=""
70 . . S OUT(STARTLIN)=$G(OUT(STARTLIN))_COSTITLE
71 . . S OUT(STARTLIN+1)=$G(OUT(STARTLIN+1))_"Patients of Fills "
72 . . S JD=$L($FN(-COST,","))
73 . . F LINE=STARTLIN+3:1:PAGELEN D Q:COST=""
74 . . . S NPATS=$G(^TMP("SPN",$J,"RX",COSTNODE,COST))
75 . . . S OUT(LINE)=$G(OUT(LINE))_$J($FN(NPATS,","),7)_$J($FN(-COST,","),9)_"-"_$$PAD^SPNLRU($J($FN(-COST+99,","),JD),9-JD)
76 . . . S COST=$O(^TMP("SPN",$J,"RX",COSTNODE,COST))
77 . S LINE=""
78 . F S LINE=$O(OUT(LINE)) Q:LINE="" D
79 . . W !,OUT(LINE)
80 Q
Note: See TracBrowser for help on using the repository browser.