| 1 | SPNLGSRX ; ISC-SF/GMB - SCD GATHER (SPECIFIC) OUTPATIENT PHARMACY DATA;16 JUN 94 [ 07/02/94 4:24 PM ] ;6/23/95 11:49
|
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|---|
| 3 | SELECT(DFN,FDATE,TDATE,HI,QLIST) ;
|
|---|
| 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 | ; "DRUG",drugnr) # fills for this drug
|
|---|
| 13 | ; "DRUG",drugnr,"NAME") name of this drug
|
|---|
| 14 | ; "DRUG",drugnr,"PAT") # patients who had this drug
|
|---|
| 15 | ; "DRUG",drugnr,"PRICE") current unit price (cost) of this drug
|
|---|
| 16 | ; "DRUG",drugnr,"QTY") total quantity of all fills for this drug
|
|---|
| 17 | ; "DRUG",drugnr,"PID",patient name^SSN) fills^qty
|
|---|
| 18 | N EXPDATE,RECNR,ZEROREC,TWOREC,ZDRUGNR,FILLS,UNITVAL,PNAME,PSSN
|
|---|
| 19 | N FILLDATE,QTY,SUBRECNR
|
|---|
| 20 | I '$D(TDATE) S TDATE=DT
|
|---|
| 21 | ; We are interested in any drug whose prescription 'expiration' or
|
|---|
| 22 | ; 'cancel' date falls on or after the 'from' date.
|
|---|
| 23 | ; We are going to take only the fills or refills which occurred
|
|---|
| 24 | ; during the 'from'-'thru' date range.
|
|---|
| 25 | S EXPDATE=FDATE-.000001 ; for each expiration date
|
|---|
| 26 | F S EXPDATE=$O(^PS(55,DFN,"P","A",EXPDATE)) Q:EXPDATE'>0 D
|
|---|
| 27 | . S RECNR=0 ; for each prescription on that date
|
|---|
| 28 | . F S RECNR=$O(^PS(55,DFN,"P","A",EXPDATE,RECNR)) Q:RECNR'>0 D
|
|---|
| 29 | . . S TWOREC=$G(^PSRX(RECNR,2)) ; follow ptr to get prescripton info
|
|---|
| 30 | . . Q:TWOREC=""
|
|---|
| 31 | . . S FILLDATE=$P(TWOREC,U,2)
|
|---|
| 32 | . . Q:FILLDATE>TDATE
|
|---|
| 33 | . . S ZEROREC=$G(^PSRX(RECNR,0))
|
|---|
| 34 | . . Q:ZEROREC=""
|
|---|
| 35 | . . S ZDRUGNR=+$P(ZEROREC,U,6)
|
|---|
| 36 | . . Q:'$D(QLIST(ZDRUGNR))
|
|---|
| 37 | . . S (FILLS,QTY)=0
|
|---|
| 38 | . . I FILLDATE'<FDATE,FILLDATE'>TDATE D TRACKIT(.FILLS,.QTY,$P(ZEROREC,U,7))
|
|---|
| 39 | . . S SUBRECNR=0 ; for each refill of the drug
|
|---|
| 40 | . . F S SUBRECNR=$O(^PSRX(RECNR,1,SUBRECNR)) Q:SUBRECNR'>0 D
|
|---|
| 41 | . . . S ZEROREC=$G(^PSRX(RECNR,1,SUBRECNR,0))
|
|---|
| 42 | . . . S FILLDATE=$P(ZEROREC,U,1)
|
|---|
| 43 | . . . Q:FILLDATE<FDATE!(FILLDATE>TDATE)
|
|---|
| 44 | . . . D TRACKIT(.FILLS,.QTY,$P(ZEROREC,U,4))
|
|---|
| 45 | . . Q:'FILLS
|
|---|
| 46 | . . S FILLS(ZDRUGNR)=$G(FILLS(ZDRUGNR))+FILLS
|
|---|
| 47 | . . S QTY(ZDRUGNR)=$G(QTY(ZDRUGNR))+QTY
|
|---|
| 48 | Q:$D(FILLS)<10 ; make sure this array has descendants
|
|---|
| 49 | D:HI GETNAME^SPNLRU(DFN,.PNAME,.PSSN)
|
|---|
| 50 | S ZDRUGNR="" ; for each drug
|
|---|
| 51 | F S ZDRUGNR=$O(FILLS(ZDRUGNR)) Q:ZDRUGNR="" D
|
|---|
| 52 | . S ^("PAT")=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"PAT"))+1
|
|---|
| 53 | . S FILLS=FILLS(ZDRUGNR)
|
|---|
| 54 | . S ^(ZDRUGNR)=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR))+FILLS
|
|---|
| 55 | . S ^("QTY")=$G(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"QTY"))+QTY(ZDRUGNR)
|
|---|
| 56 | . S:HI ^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"PID",PNAME_U_PSSN)=FILLS_U_QTY
|
|---|
| 57 | Q
|
|---|
| 58 | TRACKIT(FILLS,QTY,FILLQTY) ;
|
|---|
| 59 | S FILLS=FILLS+1
|
|---|
| 60 | S QTY=QTY+FILLQTY
|
|---|
| 61 | Q
|
|---|
| 62 | PRICEIT ; gets the current unit price (cost) of each of the drugs
|
|---|
| 63 | N ZDRUGNR,UNITVAL
|
|---|
| 64 | S ZDRUGNR="" ; We might have a drug number which is zero...
|
|---|
| 65 | F S ZDRUGNR=$O(^TMP("SPN",$J,"RX","DRUG",ZDRUGNR)) Q:ZDRUGNR="" D
|
|---|
| 66 | . S UNITVAL=+$P($G(^PSDRUG(ZDRUGNR,660)),U,6) ; current price
|
|---|
| 67 | . S ^TMP("SPN",$J,"RX","DRUG",ZDRUGNR,"PRICE")=UNITVAL
|
|---|
| 68 | Q
|
|---|
