source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGRRX.m@ 686

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1SPNLGRRX ; ISC-SF/GMB - SCD GATHER OUTPATIENT PHARMACY DATA;11 MAY 94 [ 08/08/94 1:26 PM ] ;6/23/95 11:42
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,"RX",
11 ; with the following nodes:
12 ; "PAT") # patients with at least 1 fill
13 ; "FILLS") # fills of all drugs
14 ; "FILLS",-fills) # patients with this many fills of all drugs
15 ; "COST",-cost) # patients whose total drug cost is in this
16 ; dollar range (cost thru cost+99)
17 ; "VAL",-value) # patients whose total drug value is in this
18 ; dollar range (value thru value+99)
19 ; "DRUG",drugnr) # fills for this drug
20 ; "DRUG",drugnr,"NAME") name of this drug
21 ; "DRUG",drugnr,"PAT") # patients who had this drug
22 ; "DRUG",drugnr,"COST") actual cost of all fills for this drug
23 ; "DRUG",drugnr,"VAL") current value of all fills for this drug
24 ; "DRUG",drugnr,"QTY") total quantity of all fills for this drug
25 ; "DRUG",drugnr,"FILLS",-fills) # patients who had this many fills of this drug
26 ; ...and track usage by individual patient ranked by:
27 ; "HI","H1",-fills,-diff drugs,-cost,DFN)
28 ; "HI","H2",-cost,-fills,-diff drugs,DFN)
29 ; "HI","H3",-fills,-diff drugs,-value,DFN)
30 ; "HI","H4",-value,-fills,-diff drugs,DFN)
31 N EXPDATE,RECNR,ZEROREC,TWOREC,ZDRUGNR,FILLS,COST,RANGE,UNITVAL
32 N FILLDATE,QTY,SUBRECNR,TOTFILLS,TOTCOST,TOTVAL,NDDRUGS
33 I '$D(TDATE) S TDATE=DT
34 ; We are interested in any drug whose prescription 'expiration' or
35 ; 'cancel' date falls on or after the 'from' date.
36 ; We are going to take only the fills or refills which occurred
37 ; during the 'from'-'thru' date range.
38 S (TOTFILLS,TOTCOST)=0
39 S EXPDATE=FDATE-.000001 ; for each expiration date
40 F S EXPDATE=$O(^PS(55,DFN,"P","A",EXPDATE)) Q:EXPDATE'>0 D
41 . S RECNR=0 ; for each prescription on that date
42 . F S RECNR=$O(^PS(55,DFN,"P","A",EXPDATE,RECNR)) Q:RECNR'>0 D
43 . . S TWOREC=$G(^PSRX(RECNR,2)) ; follow ptr to get prescripton info
44 . . Q:TWOREC=""
45 . . S FILLDATE=$P(TWOREC,U,2)
46 . . Q:FILLDATE>TDATE
47 . . S ZEROREC=$G(^PSRX(RECNR,0))
48 . . Q:ZEROREC=""
49 . . S ZDRUGNR=+$P(ZEROREC,U,6)
50 . . S (FILLS,COST,QTY)=0
51 . . I FILLDATE'<FDATE,FILLDATE'>TDATE D TRACKIT(.FILLS,.COST,.QTY,$P(ZEROREC,U,7),$P(ZEROREC,U,17))
52 . . S SUBRECNR=0 ; for each refill of the drug
53 . . F S SUBRECNR=$O(^PSRX(RECNR,1,SUBRECNR)) Q:SUBRECNR'>0 D
54 . . . S ZEROREC=$G(^PSRX(RECNR,1,SUBRECNR,0))
55 . . . S FILLDATE=$P(ZEROREC,U,1)
56 . . . Q:FILLDATE<FDATE!(FILLDATE>TDATE)
57 . . . D TRACKIT(.FILLS,.COST,.QTY,$P(ZEROREC,U,4),$P(ZEROREC,U,11))
58 . . Q:'FILLS
59 . . S TOTFILLS=TOTFILLS+FILLS
60 . . S TOTCOST=TOTCOST+COST
61 . . S FILLS(ZDRUGNR)=$G(FILLS(ZDRUGNR))+FILLS
62 . . S QTY(ZDRUGNR)=$G(QTY(ZDRUGNR))+QTY
63 . . S ^("COST")=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"COST"))+COST
64 Q:TOTFILLS=0
65 S ^("PAT")=$G(^TMP("SPN",$J,"RX","PAT"))+1
66 S ^("FILLS")=$G(^TMP("SPN",$J,"RX","FILLS"))+TOTFILLS
67 S ^(-TOTFILLS)=$G(^TMP("SPN",$J,"RX","FILLS",-TOTFILLS))+1
68 S RANGE=TOTCOST\100*100
69 S ^(-RANGE)=$G(^TMP("SPN",$J,"RX","COST",-RANGE))+1
70 S (TOTVAL,NDDRUGS)=0,ZDRUGNR="" ; for each drug
71 F S ZDRUGNR=$O(FILLS(ZDRUGNR)) Q:ZDRUGNR="" D
72 . S NDDRUGS=NDDRUGS+1 ; number of different drugs
73 . S ^("PAT")=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"PAT"))+1
74 . S FILLS=FILLS(ZDRUGNR)
75 . S ^(ZDRUGNR)=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR))+FILLS
76 . S ^(-FILLS)=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"FILLS",-FILLS))+1
77 . S ^("QTY")=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"QTY"))+QTY(ZDRUGNR)
78 . S UNITVAL=+$P($G(^PSDRUG(ZDRUGNR,660)),U,6) ; current price
79 . S TOTVAL=QTY(ZDRUGNR)*UNITVAL+TOTVAL
80 S RANGE=TOTVAL\100*100
81 S ^(-RANGE)=$G(^TMP("SPN",$J,"RX","VAL",-RANGE))+1
82 Q:'HI
83 S ^TMP("SPN",$J,"RX","HI","H1",-TOTFILLS,-NDDRUGS,-TOTCOST,DFN)=""
84 S ^TMP("SPN",$J,"RX","HI","H2",-TOTCOST,-TOTFILLS,-NDDRUGS,DFN)=""
85 S ^TMP("SPN",$J,"RX","HI","H3",-TOTFILLS,-NDDRUGS,-TOTVAL,DFN)=""
86 S ^TMP("SPN",$J,"RX","HI","H4",-TOTVAL,-TOTFILLS,-NDDRUGS,DFN)=""
87 Q
88TRACKIT(FILLS,COST,QTY,FILLQTY,UNITCOST) ;
89 S FILLS=FILLS+1
90 S COST=UNITCOST*FILLQTY+COST
91 S QTY=QTY+FILLQTY
92 Q
93NAMEIT ; names the drugs and gives current value of dispensed quantities
94 N ZDRUGNR,UNITVAL,ZDRUGNAM
95 S ZDRUGNR="" ; We might have a drug number which is zero...
96 F S ZDRUGNR=$O(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR)) Q:ZDRUGNR="" D
97 . S ZDRUGNAM=$P($G(^PSDRUG(ZDRUGNR,0)),U,1)
98 . I ZDRUGNAM="" S ZDRUGNAM="Not Identified"
99 . S ^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"NAME")=ZDRUGNAM
100 . S UNITVAL=+$P($G(^PSDRUG(ZDRUGNR,660)),U,6) ; current price
101 . S ^("VAL")=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"QTY"))*UNITVAL
102 Q
Note: See TracBrowser for help on using the repository browser.