- PSOPXRM1 ;BHAM ISC/MR - Returns Patient's Prescrition info ;22-Oct-2012 09:43;DU
- ;;7.0;OUTPATIENT PHARMACY;**118,1015**;DEC 1997;Build 62
- ; Modified - IHS/MSC/MGH - 10/22/2012 - Line ORIG+5
- ; IHS/MSC/MGH Modfied to get fields needed for E-prescribing prescriptions
- ;
- NVA(DAS,DATA) ;Return data on non-VA meds.
- N EM,IND1,IND2,IND3,IND4,TEMP,TEMP1
- S IND1=$P(DAS,";",1),IND2=$P(DAS,";",2),IND3=$P(DAS,";",3),IND4=$P(DAS,";",4)
- ;W !,"IN NVA^PSOPXRM1" BREAK
- S TEMP=^PS(55,IND1,IND2,IND3,IND4)
- S TEMP1=^PS(50.7,$P(TEMP,U,1),0)
- ;DBIA #2223
- S DATA("ORDERABLE ITEM")=$P(TEMP1,U,1)
- ;DBIA #2174
- S DATA("DOSAGE FORM")=^PS(50.606,$P(TEMP1,U,2),0)
- S DATA("DISPENSE DRUG")=$P(TEMP,U,2)
- S DATA("DOSAGE")=$P(TEMP,U,3)
- S DATA("MEDICATION ROUTE")=$P(TEMP,U,4)
- S DATA("SCHEDULE")=$P(TEMP,U,5)
- S TEMP1=$P(TEMP,U,6)
- S DATA("STATUS")=$S(TEMP1="":"ACTIVE",1:$$EXTERNAL^DILFD(55.05,5,"",TEMP1,.EM))
- S DATA("DISCONTINUED DATE")=$P(TEMP,U,7)
- S DATA("ORDER NUMBER")=$P(TEMP,U,8)
- S DATA("START DATE")=$P(TEMP,U,9)
- S DATA("DOCUMENTED DATE")=$P(TEMP,U,10)
- S DATA("DOCUMENTED BY")=$P(TEMP,U,11)
- S DATA("CLINIC")=$P(TEMP,U,12)
- ;W !,"NVA^PSOPXRM1 DONE" BREAK
- Q
- ;
- ;====================================================
- PSRX(DAS,RXAR) ; Returns Rx Information
- ; Input: DAS - String containing the ^PSRX location where the data
- ; is located, separated by ";" (semi-colon).
- ; Example: "329832;1;1;0" -> ^PSRX(329832,1,1,0)
- ;Output: .RXAR - Array/Global to be returned with the Rx Info (by Ref)
- ; Return: RXAR(Field Name)=Internal Value
- ;
- N SB1,SB2,SB3,I,DA
- ;
- ; - Retrieving ^PSRX subscripts
- F I=1:1:3 S @("SB"_I)=$P(DAS,";",I)
- ;
- ; - Call appropriate sub-routine (Original, Refill or Partial)
- S DA=SB1 K RXAR D @($S(SB3="":"ORIG",SB2'="P":"REFL",1:"PRTL"))
- ;
- ; - Retrieve common fields
- S RXAR("STATUS")=+$G(^PSRX(DA,"STA"))
- ;
- END Q
- ;
- ORIG ; - Retrieve Original fields
- N RX0,RX2 S RX0=$G(^PSRX(DA,0)),RX2=$G(^PSRX(DA,2))
- S RXAR("DAYS SUPPLY")=$P(RX0,"^",8)
- S RXAR("PHARMACIST")=$P(RX2,"^",3)
- S RXAR("RELEASED DATE/TIME")=$P(RX2,"^",13)
- ;IHS/MSC/MGH added these fields for E-prescribing
- S RXAR("FILL DATE")=$P(RX2,"^",2)
- S RXAR("REFILLS")=$P(RX0,"^",9)
- Q
- ;
- REFL ; - Retrieve Refill fields
- N RF0 S RF0=$G(^PSRX(DA,1,SB3,0))
- S RXAR("DAYS SUPPLY")=$P(RF0,"^",10)
- S RXAR("PHARMACIST")=$P(RF0,"^",5)
- S RXAR("RELEASED DATE/TIME")=$P(RF0,"^",18)
- Q
- ;
- PRTL ; - Retrieve Partial fields
- N PT0 S PT0=$G(^PSRX(DA,"P",SB3,0))
- S RXAR("DAYS SUPPLY")=$P(PT0,"^",10)
- S RXAR("PHARMACIST")=$P(PT0,"^",5)
- S RXAR("RELEASED DATE/TIME")=$P(PT0,"^",19)
- Q
- PSOPXRM1 ;BHAM ISC/MR - Returns Patient's Prescrition info ;22-Oct-2012 09:43;DU
- +1 ;;7.0;OUTPATIENT PHARMACY;**118,1015**;DEC 1997;Build 62
- +2 ; Modified - IHS/MSC/MGH - 10/22/2012 - Line ORIG+5
- +3 ; IHS/MSC/MGH Modfied to get fields needed for E-prescribing prescriptions
- +4 ;
- NVA(DAS,DATA) ;Return data on non-VA meds.
- +1 NEW EM,IND1,IND2,IND3,IND4,TEMP,TEMP1
- +2 SET IND1=$PIECE(DAS,";",1)
- SET IND2=$PIECE(DAS,";",2)
- SET IND3=$PIECE(DAS,";",3)
- SET IND4=$PIECE(DAS,";",4)
- +3 ;W !,"IN NVA^PSOPXRM1" BREAK
- +4 SET TEMP=^PS(55,IND1,IND2,IND3,IND4)
- +5 SET TEMP1=^PS(50.7,$PIECE(TEMP,U,1),0)
- +6 ;DBIA #2223
- +7 SET DATA("ORDERABLE ITEM")=$PIECE(TEMP1,U,1)
- +8 ;DBIA #2174
- +9 SET DATA("DOSAGE FORM")=^PS(50.606,$PIECE(TEMP1,U,2),0)
- +10 SET DATA("DISPENSE DRUG")=$PIECE(TEMP,U,2)
- +11 SET DATA("DOSAGE")=$PIECE(TEMP,U,3)
- +12 SET DATA("MEDICATION ROUTE")=$PIECE(TEMP,U,4)
- +13 SET DATA("SCHEDULE")=$PIECE(TEMP,U,5)
- +14 SET TEMP1=$PIECE(TEMP,U,6)
- +15 SET DATA("STATUS")=$SELECT(TEMP1="":"ACTIVE",1:$$EXTERNAL^DILFD(55.05,5,"",TEMP1,.EM))
- +16 SET DATA("DISCONTINUED DATE")=$PIECE(TEMP,U,7)
- +17 SET DATA("ORDER NUMBER")=$PIECE(TEMP,U,8)
- +18 SET DATA("START DATE")=$PIECE(TEMP,U,9)
- +19 SET DATA("DOCUMENTED DATE")=$PIECE(TEMP,U,10)
- +20 SET DATA("DOCUMENTED BY")=$PIECE(TEMP,U,11)
- +21 SET DATA("CLINIC")=$PIECE(TEMP,U,12)
- +22 ;W !,"NVA^PSOPXRM1 DONE" BREAK
- +23 QUIT
- +24 ;
- +25 ;====================================================
- PSRX(DAS,RXAR) ; Returns Rx Information
- +1 ; Input: DAS - String containing the ^PSRX location where the data
- +2 ; is located, separated by ";" (semi-colon).
- +3 ; Example: "329832;1;1;0" -> ^PSRX(329832,1,1,0)
- +4 ;Output: .RXAR - Array/Global to be returned with the Rx Info (by Ref)
- +5 ; Return: RXAR(Field Name)=Internal Value
- +6 ;
- +7 NEW SB1,SB2,SB3,I,DA
- +8 ;
- +9 ; - Retrieving ^PSRX subscripts
- +10 FOR I=1:1:3
- SET @("SB"_I)=$PIECE(DAS,";",I)
- +11 ;
- +12 ; - Call appropriate sub-routine (Original, Refill or Partial)
- +13 SET DA=SB1
- KILL RXAR
- DO @($SELECT(SB3="":"ORIG",SB2'="P":"REFL",1:"PRTL"))
- +14 ;
- +15 ; - Retrieve common fields
- +16 SET RXAR("STATUS")=+$GET(^PSRX(DA,"STA"))
- +17 ;
- END QUIT
- +1 ;
- ORIG ; - Retrieve Original fields
- +1 NEW RX0,RX2
- SET RX0=$GET(^PSRX(DA,0))
- SET RX2=$GET(^PSRX(DA,2))
- +2 SET RXAR("DAYS SUPPLY")=$PIECE(RX0,"^",8)
- +3 SET RXAR("PHARMACIST")=$PIECE(RX2,"^",3)
- +4 SET RXAR("RELEASED DATE/TIME")=$PIECE(RX2,"^",13)
- +5 ;IHS/MSC/MGH added these fields for E-prescribing
- +6 SET RXAR("FILL DATE")=$PIECE(RX2,"^",2)
- +7 SET RXAR("REFILLS")=$PIECE(RX0,"^",9)
- +8 QUIT
- +9 ;
- REFL ; - Retrieve Refill fields
- +1 NEW RF0
- SET RF0=$GET(^PSRX(DA,1,SB3,0))
- +2 SET RXAR("DAYS SUPPLY")=$PIECE(RF0,"^",10)
- +3 SET RXAR("PHARMACIST")=$PIECE(RF0,"^",5)
- +4 SET RXAR("RELEASED DATE/TIME")=$PIECE(RF0,"^",18)
- +5 QUIT
- +6 ;
- PRTL ; - Retrieve Partial fields
- +1 NEW PT0
- SET PT0=$GET(^PSRX(DA,"P",SB3,0))
- +2 SET RXAR("DAYS SUPPLY")=$PIECE(PT0,"^",10)
- +3 SET RXAR("PHARMACIST")=$PIECE(PT0,"^",5)
- +4 SET RXAR("RELEASED DATE/TIME")=$PIECE(PT0,"^",19)
- +5 QUIT
