ABSPFUNC.m

ABSPFUNC ;IHS/ITSC/ENM - MISC FUNCTIONS [ 02/24/2004  9:00 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**10,46**;JUN 21, 2001;Build 38

 ;

 ;-------------------------------------------------------------

 ;IHS/SD/lwj 03/10/04 Patch 10

 ; This routine is being borrowed from Outpatient Pharmacy 6.0 and

 ; was originated by Edgar Moore.  Eventually, the real routine

 ; (APSPFUNC) will be distributed in an official release of Outpatient

 ; Pharmacy V6.0 and V7.0 as an API, but due to urgent issues 

 ; presented by the onset of the EHR project, an immediate release

 ; of this code needed to be done within the individual packages

 ; affected by the change in the NDC refill field location.

 ;

 ; This routine is being included in POS as a result of:

 ;NOTICE TO ALL DEVELOPERS WITH APPLICATIONS THAT REFERENCE THE

 ; OUTPATIENT PHARMACY PRESCRIPTION FILE #52 (REFILL SUB-FILE,

 ; NDC FIELD #11)

 ; The Veterans Administration, Outpatient Pharmacy Developers have

 ; made a Data Dictionary change to the NDC field #11 in the Prescription

 ; File 52, REFILL Sub-File.  This change was made in Outpatient Pharmacy

 ; V.7.0 Patch #29.

 ;----------------------------------------------------------------------

 ;

 ; Return NDC value

 ;input: RXIEN - Prescription IEN

 ;       RFIEN - Refill IEN

 ; Output: NDC value

NDCVAL(RX,RF)      ; EP - API Return NDC Value

 ; NDC value for prescription is returned if Refill IEN is not supplied

 N IENS,FILE,FLD

 S RF=$G(RF,0)

 Q:'$G(RX) ""

 S IENS=$S(RF:RF_","_RX_",",1:RX_",")

 S FILE=$S(RF:52.1,1:52)

 S FLD=$S(RF:11,1:27)

 Q $$GET1^DIQ(FILE,IENS,FLD)

 Q

RFNDC(RX,RF,APSPNDC)       ;EP API SET NDC FLD #11

 ;Set Refill NDC

 ;Input RX - Prescription IEN

 ;      RF - Refill IEN

 ; APSPNDC - NDC

 Q:'$G(RX) ""

 S DA(1)=RX,DIE="^PSRX(DA(1),1,"

 S DA=RF

 S DR="11////"_APSPNDC

 D ^DIE

 K DA,DIE,DR,DA,APSPNDC,RX,RF

 Q

ISOR1(RX) ;Find Filed 419 value using OR1 (Order #)

 ;OIT/CAS/RCS 090913 Patch 46

 N OR1,NEW

 S OR1=$P($G(^PSRX(RX,"OR1")),U,2)

 I 'OR1 Q "" ;Not set

 S NEW=$O(^OR(100,OR1,8,"C","NW","")) ;Find New entry

 I 'NEW Q "" ;No New entry found

 S TYP=$P($G(^OR(100,OR1,8,NEW,0)),U,12)

 I 'TYP Q "" ;Type not set

 I TYP=1 Q 0 ;Written

 I TYP=8 Q 1 ;Electronic

 Q "" ;Type not used

ABSPFUNC  ;IHS/ITSC/ENM - MISC FUNCTIONS [ 02/24/2004  9:00 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**10,46**;JUN 21, 2001;Build 38

 +2       ;

 +3       ;-------------------------------------------------------------

 +4       ;IHS/SD/lwj 03/10/04 Patch 10

 +5       ; This routine is being borrowed from Outpatient Pharmacy 6.0 and

 +6       ; was originated by Edgar Moore.  Eventually, the real routine

 +7       ; (APSPFUNC) will be distributed in an official release of Outpatient

 +8       ; Pharmacy V6.0 and V7.0 as an API, but due to urgent issues 

 +9       ; presented by the onset of the EHR project, an immediate release

 +10      ; of this code needed to be done within the individual packages

 +11      ; affected by the change in the NDC refill field location.

 +12      ;

 +13      ; This routine is being included in POS as a result of:

 +14      ;NOTICE TO ALL DEVELOPERS WITH APPLICATIONS THAT REFERENCE THE

 +15      ; OUTPATIENT PHARMACY PRESCRIPTION FILE #52 (REFILL SUB-FILE,

 +16      ; NDC FIELD #11)

 +17      ; The Veterans Administration, Outpatient Pharmacy Developers have

 +18      ; made a Data Dictionary change to the NDC field #11 in the Prescription

 +19      ; File 52, REFILL Sub-File.  This change was made in Outpatient Pharmacy

 +20      ; V.7.0 Patch #29.

 +21      ;----------------------------------------------------------------------

 +22      ;

 +23      ; Return NDC value

 +24      ;input: RXIEN - Prescription IEN

 +25      ;       RFIEN - Refill IEN

 +26      ; Output: NDC value

NDCVAL(RX,RF) ; EP - API Return NDC Value

 +1       ; NDC value for prescription is returned if Refill IEN is not supplied

 +2        NEW IENS,FILE,FLD

 +3        SET RF=$GET(RF,0)

 +4        IF '$GET(RX)

               QUIT ""

 +5        SET IENS=$SELECT(RF:RF_","_RX_",",1:RX_",")

 +6        SET FILE=$SELECT(RF:52.1,1:52)

 +7        SET FLD=$SELECT(RF:11,1:27)

 +8        QUIT $$GET1^DIQ(FILE,IENS,FLD)

 +9        QUIT 

RFNDC(RX,RF,APSPNDC) ;EP API SET NDC FLD #11

 +1       ;Set Refill NDC

 +2       ;Input RX - Prescription IEN

 +3       ;      RF - Refill IEN

 +4       ; APSPNDC - NDC

 +5        IF '$GET(RX)

               QUIT ""

 +6        SET DA(1)=RX

           SET DIE="^PSRX(DA(1),1,"

 +7        SET DA=RF

 +8        SET DR="11////"_APSPNDC

 +9        DO ^DIE

 +10       KILL DA,DIE,DR,DA,APSPNDC,RX,RF

 +11       QUIT 

ISOR1(RX) ;Find Filed 419 value using OR1 (Order #)

 +1       ;OIT/CAS/RCS 090913 Patch 46

 +2        NEW OR1,NEW

 +3        SET OR1=$PIECE($GET(^PSRX(RX,"OR1")),U,2)

 +4       ;Not set

           IF 'OR1

               QUIT ""

 +5       ;Find New entry

           SET NEW=$ORDER(^OR(100,OR1,8,"C","NW",""))

 +6       ;No New entry found

           IF 'NEW

               QUIT ""

 +7        SET TYP=$PIECE($GET(^OR(100,OR1,8,NEW,0)),U,12)

 +8       ;Type not set

           IF 'TYP

               QUIT ""

 +9       ;Written

           IF TYP=1

               QUIT 0

 +10      ;Electronic

           IF TYP=8

               QUIT 1

 +11      ;Type not used

           QUIT ""