PSOPXRM1.m

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