| 1 | PSOPXRM1 ;BHAM ISC/MR - Returns Patient's Prescrition info ; 07/12/2004
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**118**;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | NVA(DAS,DATA) ;Return data on non-VA meds.
|
|---|
| 5 | N EM,IND1,IND2,IND3,IND4,TEMP,TEMP1
|
|---|
| 6 | S IND1=$P(DAS,";",1),IND2=$P(DAS,";",2),IND3=$P(DAS,";",3),IND4=$P(DAS,";",4)
|
|---|
| 7 | ;W !,"IN NVA^PSOPXRM1" BREAK
|
|---|
| 8 | S TEMP=^PS(55,IND1,IND2,IND3,IND4)
|
|---|
| 9 | S TEMP1=^PS(50.7,$P(TEMP,U,1),0)
|
|---|
| 10 | ;DBIA #2223
|
|---|
| 11 | S DATA("ORDERABLE ITEM")=$P(TEMP1,U,1)
|
|---|
| 12 | ;DBIA #2174
|
|---|
| 13 | S DATA("DOSAGE FORM")=^PS(50.606,$P(TEMP1,U,2),0)
|
|---|
| 14 | S DATA("DISPENSE DRUG")=$P(TEMP,U,2)
|
|---|
| 15 | S DATA("DOSAGE")=$P(TEMP,U,3)
|
|---|
| 16 | S DATA("MEDICATION ROUTE")=$P(TEMP,U,4)
|
|---|
| 17 | S DATA("SCHEDULE")=$P(TEMP,U,5)
|
|---|
| 18 | S TEMP1=$P(TEMP,U,6)
|
|---|
| 19 | S DATA("STATUS")=$S(TEMP1="":"ACTIVE",1:$$EXTERNAL^DILFD(55.05,5,"",TEMP1,.EM))
|
|---|
| 20 | S DATA("DISCONTINUED DATE")=$P(TEMP,U,7)
|
|---|
| 21 | S DATA("ORDER NUMBER")=$P(TEMP,U,8)
|
|---|
| 22 | S DATA("START DATE")=$P(TEMP,U,9)
|
|---|
| 23 | S DATA("DOCUMENTED DATE")=$P(TEMP,U,10)
|
|---|
| 24 | S DATA("DOCUMENTED BY")=$P(TEMP,U,11)
|
|---|
| 25 | S DATA("CLINIC")=$P(TEMP,U,12)
|
|---|
| 26 | ;W !,"NVA^PSOPXRM1 DONE" BREAK
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;====================================================
|
|---|
| 30 | PSRX(DAS,RXAR) ; Returns Rx Information
|
|---|
| 31 | ; Input: DAS - String containing the ^PSRX location where the data
|
|---|
| 32 | ; is located, separated by ";" (semi-colon).
|
|---|
| 33 | ; Example: "329832;1;1;0" -> ^PSRX(329832,1,1,0)
|
|---|
| 34 | ;Output: .RXAR - Array/Global to be returned with the Rx Info (by Ref)
|
|---|
| 35 | ; Return: RXAR(Field Name)=Internal Value
|
|---|
| 36 | ;
|
|---|
| 37 | N SB1,SB2,SB3,I,DA
|
|---|
| 38 | ;
|
|---|
| 39 | ; - Retrieving ^PSRX subscripts
|
|---|
| 40 | F I=1:1:3 S @("SB"_I)=$P(DAS,";",I)
|
|---|
| 41 | ;
|
|---|
| 42 | ; - Call appropriate sub-routine (Original, Refill or Partial)
|
|---|
| 43 | S DA=SB1 K RXAR D @($S(SB3="":"ORIG",SB2'="P":"REFL",1:"PRTL"))
|
|---|
| 44 | ;
|
|---|
| 45 | ; - Retrieve common fields
|
|---|
| 46 | S RXAR("STATUS")=+$G(^PSRX(DA,"STA"))
|
|---|
| 47 | ;
|
|---|
| 48 | END Q
|
|---|
| 49 | ;
|
|---|
| 50 | ORIG ; - Retrieve Original fields
|
|---|
| 51 | N RX0,RX2 S RX0=$G(^PSRX(DA,0)),RX2=$G(^PSRX(DA,2))
|
|---|
| 52 | S RXAR("DAYS SUPPLY")=$P(RX0,"^",8)
|
|---|
| 53 | S RXAR("PHARMACIST")=$P(RX2,"^",3)
|
|---|
| 54 | S RXAR("RELEASED DATE/TIME")=$P(RX2,"^",13)
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | REFL ; - Retrieve Refill fields
|
|---|
| 58 | N RF0 S RF0=$G(^PSRX(DA,1,SB3,0))
|
|---|
| 59 | S RXAR("DAYS SUPPLY")=$P(RF0,"^",10)
|
|---|
| 60 | S RXAR("PHARMACIST")=$P(RF0,"^",5)
|
|---|
| 61 | S RXAR("RELEASED DATE/TIME")=$P(RF0,"^",18)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | PRTL ; - Retrieve Partial fields
|
|---|
| 65 | N PT0 S PT0=$G(^PSRX(DA,"P",SB3,0))
|
|---|
| 66 | S RXAR("DAYS SUPPLY")=$P(PT0,"^",10)
|
|---|
| 67 | S RXAR("PHARMACIST")=$P(PT0,"^",5)
|
|---|
| 68 | S RXAR("RELEASED DATE/TIME")=$P(PT0,"^",19)
|
|---|
| 69 | Q
|
|---|
