Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOPXRM1

PSOPXRM1.m

Go to the documentation of this file.
  1. PSOPXRM1 ;BHAM ISC/MR - Returns Patient's Prescription info ;10/16/09 15:07
  1. ;;7.0;OUTPATIENT PHARMACY;**118,344,441**;DEC 1997;Build 208
  1. ;External reference to ^PS(55 supported by DBIA 2228
  1. ;External reference to ^PS(50.7 supported by DBIA 2223
  1. ;External reference to ^PS(50.606 supported by DBIA 2174
  1. ;External reference to ^PSDRUG( supported by DBIA 221
  1. ;
  1. NVA(DAS,DATA) ;Return data on non-VA meds.
  1. N EM,IND1,IND2,IND3,IND4,TEMP,TEMP1
  1. S IND1=$P(DAS,";",1),IND2=$P(DAS,";",2),IND3=$P(DAS,";",3),IND4=$P(DAS,";",4)
  1. S TEMP=^PS(55,IND1,IND2,IND3,IND4)
  1. S TEMP1=^PS(50.7,$P(TEMP,U,1),0)
  1. S DATA("ORDERABLE ITEM")=$P(TEMP1,U,1)
  1. S DATA("DOSAGE FORM")=^PS(50.606,$P(TEMP1,U,2),0)
  1. S DATA("DISPENSE DRUG")=$P(TEMP,U,2)
  1. S DATA("DOSAGE")=$P(TEMP,U,3)
  1. S DATA("MEDICATION ROUTE")=$P(TEMP,U,4)
  1. S DATA("SCHEDULE")=$P(TEMP,U,5)
  1. S TEMP1=$P(TEMP,U,6)
  1. S DATA("STATUS")=$S(TEMP1="":"ACTIVE",1:$$EXTERNAL^DILFD(55.05,5,"",TEMP1,.EM))
  1. S DATA("DISCONTINUED DATE")=$P(TEMP,U,7)
  1. S DATA("ORDER NUMBER")=$P(TEMP,U,8)
  1. S DATA("START DATE")=$P(TEMP,U,9)
  1. S DATA("DOCUMENTED DATE")=$P(TEMP,U,10)
  1. S DATA("DOCUMENTED BY")=$P(TEMP,U,11)
  1. S DATA("CLINIC")=$P(TEMP,U,12)
  1. S DATA("INDICATION")=$P($G(^PS(55,IND1,IND2,2,2)),U)
  1. Q
  1. ;
  1. ;====================================================
  1. PSRX(DAS,RXAR) ; Returns Rx Information
  1. ; Input: DAS - String containing the ^PSRX location where the data
  1. ; is located, separated by ";" (semi-colon).
  1. ; Example: "329832;1;1;0" -> ^PSRX(329832,1,1,0)
  1. ;Output: .RXAR - Array/Global to be returned with the Rx Info (by Ref)
  1. ; Return: RXAR(Field Name)=Internal Value^External
  1. ; Value (when applicable)
  1. ;
  1. N SB1,SB2,SB3,I,DA
  1. ;
  1. ; - Retrieving ^PSRX subscripts
  1. F I=1:1:3 S @("SB"_I)=$P(DAS,";",I)
  1. ;
  1. ; - Call appropriate sub-routine (Original, Refill or Partial)
  1. S DA=SB1 K RXAR D @($S(SB3="":"ORIG",SB2'="P":"REFL",1:"PRTL"))
  1. ;
  1. ; - Retrieve common fields
  1. N NODE0,RXCLIN
  1. S NODE0=$G(^PSRX(DA,0))
  1. S RXAR("STATUS")=+$G(^PSRX(DA,"STA"))
  1. S RXAR("ISSUE DATE")=+$P(NODE0,U,13)
  1. S RXAR("LAST DISPENSED DATE")=+$G(^PSRX(DA,3))
  1. S RXCLIN=+$P(NODE0,U,5)
  1. I RXCLIN S RXAR("CLINIC")=RXCLIN_U_$$GET1^DIQ(52,DA,5)
  1. S RXAR("PROVIDER")=$P(NODE0,U,4)_U_$$GET1^DIQ(52,DA,4)
  1. S RXAR("DISPENSE DRUG")=$P(NODE0,U,6)_U_$$GET1^DIQ(52,DA,6)
  1. S RXAR("DEA SPECIAL HDLG")=$P($G(^PSDRUG(+$P(NODE0,U,6),0)),U,3)
  1. S RXAR("INDICATION")=$P($G(^PSRX(DA,"IND")),U)
  1. ;
  1. END Q
  1. ;
  1. ORIG ; - Retrieve Original fields
  1. N RX0,RX2 S RX0=$G(^PSRX(DA,0)),RX2=$G(^PSRX(DA,2))
  1. S RXAR("DAYS SUPPLY")=$P(RX0,"^",8)
  1. S RXAR("PHARMACIST")=$S($P(RX2,"^",3):$P(RX2,"^",3)_U_$$GET1^DIQ(52,DA,23),1:"")
  1. S RXAR("RELEASED DATE/TIME")=$P(RX2,"^",13)
  1. S RXAR("QTY")=+$P(RX0,U,7)
  1. Q
  1. ;
  1. REFL ; - Retrieve Refill fields
  1. N RF0 S RF0=$G(^PSRX(DA,1,SB3,0))
  1. S RXAR("DAYS SUPPLY")=$P(RF0,"^",10)
  1. S RXAR("PHARMACIST")=$S($P(RF0,"^",5):$P(RF0,"^",5)_U_$$GET1^DIQ(52.1,SB3_","_DA,4),1:"")
  1. S RXAR("RELEASED DATE/TIME")=$P(RF0,"^",18)
  1. S RXAR("QTY")=+$P(RF0,U,4)
  1. Q
  1. ;
  1. PRTL ; - Retrieve Partial fields
  1. N PT0 S PT0=$G(^PSRX(DA,"P",SB3,0))
  1. S RXAR("DAYS SUPPLY")=$P(PT0,"^",10)
  1. S RXAR("PHARMACIST")=$S($P(PT0,"^",5):$P(PT0,"^",5)_U_$$GET1^DIQ(52.2,SB3_","_DA,.05),1:"")
  1. S RXAR("RELEASED DATE/TIME")=$P(PT0,"^",19)
  1. S RXAR("QTY")=+$P(PT0,U,4)
  1. Q