| 1 | SPNLGEUD ; ISC-SF/GMB - SCD GATHER UNIT DOSE DATA;11 MAY 94 [ 07/12/94 5:44 AM ] ;6/23/95 12:10
|
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|---|
| 3 | EXTRACT(DFN,FDATE,TDATE,CLEARTXT,ABORT) ;
|
|---|
| 4 | ; DFN Patient's internal entry number in the Patient file
|
|---|
| 5 | ; FDATE "From" date
|
|---|
| 6 | ; TDATE "Thru" date, default=today
|
|---|
| 7 | ; CLEARTXT 1=translate all codes to their meaning,
|
|---|
| 8 | ; 0=don't translate codes (default=0)
|
|---|
| 9 | N STRTDATE,STOPDATE,ORDERNUM,ZEROREC,TWOREC,SCHEDULE,RECNR,ZDRUGNAM
|
|---|
| 10 | N ZDRUGDOS,ZDRUGREC,SUBRECNR,LIMDOSE,MEDROUTE,ORDERTYP,SCHEDTYP
|
|---|
| 11 | I '$D(TDATE) S TDATE=DT
|
|---|
| 12 | I '$D(CLEARTXT) S CLEARTXT=0
|
|---|
| 13 | ; We are interested in any drug whose 'stop date' or 'start date'
|
|---|
| 14 | ; falls within the 'from' and 'thru' date range
|
|---|
| 15 | ; ('Stop date' is the last date the dose may be given.)
|
|---|
| 16 | S STOPDATE=FDATE-.000001 ; for each stop date in the range
|
|---|
| 17 | F S STOPDATE=$O(^PS(55,DFN,5,"AUS",STOPDATE)) Q:STOPDATE'>0 D
|
|---|
| 18 | . S RECNR=0 ; for each order on that date
|
|---|
| 19 | . F S RECNR=$O(^PS(55,DFN,5,"AUS",STOPDATE,RECNR)) Q:RECNR'>0 D
|
|---|
| 20 | . . S TWOREC=$G(^PS(55,DFN,5,RECNR,2))
|
|---|
| 21 | . . Q:TWOREC=""
|
|---|
| 22 | . . S STRTDATE=$P(TWOREC,U,2)\1
|
|---|
| 23 | . . Q:STRTDATE>STOPDATE!(STRTDATE=0)
|
|---|
| 24 | . . S ZEROREC=$G(^PS(55,DFN,5,RECNR,0))
|
|---|
| 25 | . . Q:ZEROREC=""
|
|---|
| 26 | . . S ORDERNUM=$P(ZEROREC,U) ; get order number
|
|---|
| 27 | . . ; Joel does the following, but why? Since order number is the .01
|
|---|
| 28 | . . ; field, it should not be null...If null, get original order number.
|
|---|
| 29 | . . ; S:'ORDERNUM ORDERNUM=$P(ZEROREC,U,18)
|
|---|
| 30 | . . S SCHEDULE=$P(TWOREC,U,1)
|
|---|
| 31 | . . S ORDERTYP=$P(ZEROREC,U,4)
|
|---|
| 32 | . . S SCHEDTYP=$P(ZEROREC,U,7)
|
|---|
| 33 | . . S LIMDOSE=$P(ZEROREC,U,11)
|
|---|
| 34 | . . S MEDROUTE=$P($G(^PS(51.2,+$P(ZEROREC,U,3),0)),U,1) ; follow ptr
|
|---|
| 35 | . . I CLEARTXT D ; translate the sets of codes
|
|---|
| 36 | . . . S ORDERTYP=$$TRANSLAT^SPNLGU(ORDERTYP,55.06,4)
|
|---|
| 37 | . . . S SCHEDTYP=$$TRANSLAT^SPNLGU(SCHEDTYP,55.06,7)
|
|---|
| 38 | . . D ADDREC^SPNLGE("UD",ORDERNUM_"^"_STRTDATE_"^"_STOPDATE\1_"^"_SCHEDULE_"^"_MEDROUTE_"^"_ORDERTYP_"^"_SCHEDTYP_"^"_LIMDOSE_"^"_$$TOTLDISP)
|
|---|
| 39 | . . S SUBRECNR="" ; for each drug in the order
|
|---|
| 40 | . . F S SUBRECNR=$O(^PS(55,DFN,5,RECNR,1,SUBRECNR)) Q:SUBRECNR="" D
|
|---|
| 41 | . . . S ZDRUGREC=$G(^PS(55,DFN,5,RECNR,1,SUBRECNR,0))
|
|---|
| 42 | . . . S ZDRUGNAM=$P($G(^PSDRUG(+$P(ZDRUGREC,U,1),0)),U,1) ;follow ptr
|
|---|
| 43 | . . . S ZDRUGDOS=$P(ZDRUGREC,U,2)
|
|---|
| 44 | . . . D ADDREC^SPNLGE("UDD",ORDERNUM_"^"_ZDRUGNAM_"^"_ZDRUGDOS)
|
|---|
| 45 | Q
|
|---|
| 46 | TOTLDISP() ; compute the total dispensed
|
|---|
| 47 | N D0,D1,DA,X
|
|---|
| 48 | S (D0,DA(1))=DFN
|
|---|
| 49 | S (D1,DA)=RECNR
|
|---|
| 50 | X $P(^DD(55.06,39,0),U,5,99)
|
|---|
| 51 | Q X
|
|---|
