ABSPOSO ; IHS/FCS/DRS - "O" is for Override NCPDP field values ; [ 08/20/2002 8:46 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,6,23**;JUN 21, 2001;Build 38
;
; File 9002313.511 ABSP NCPDP OVERRIDE
; It acts like an extension of the ^PSRX entry,
; though it's not tied to ^PSRX in any structural way.
; ^PSRX has a pointer to this file.
;
; IHS/SD/lwj 8/20/02 NCPDP 5.1 changes
; In 5.1 there is now some repeating fields/records. The DUR/PPS
; segment is a repeating segment (i.e. all the fields in this
; segment repeat.) Much like the values for the ABSP NCPDP
; Overrides are stored in a separate file, and referenced in
; the prescription file, the DUR/PPS values will be stored in
; a separate file (ABSP DUR/PPS) and simply referenced in the
; prescription file. For this reason, I'm adding the retrieval
; of the prescription DUR/PPS pointer in this routine to keep
; things consistent. (Site must have Outpatient Pharmacy V6.0
; Patch 4 loaded for the DUR/PPS field to be found.)
;
;---
;IHS/SD/lwj 6/19/03 Patch 6 - DUR segment for NCPDP 5.1
; We need to allow the pharmacist to override the DUR
; values as they exist in the 5.1 segment. New subroutine
; created to allow for both the incoming IEN value for the
; regular overrides, and the DIEN for the DUR segment
; overrides. (Subroutine will look much like OVERRIDE
; with the exception of the new parameters - new routine
; created to avoid conflict with existing code.)
;---
;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
; Added new tag GETDIAG.
Q
;
OVERRIDE(IEN) ; main entry point
; IEN points to file 9002313.511
; Sometimes we have IEN; sometimes we don't
; called from pharmacy package
; called from somewhere in POS, too
I $D(IEN) D
. I '$D(^ABSP(9002313.511,IEN)) D ; it must have been winnowed
. . S IEN=$$NEW^ABSPOSO2
E D
. I '$D(IEN) S IEN=$$NEW^ABSPOSO2
I 'IEN D IMPOSS^ABSPOSUE("FM,P","TI","Failed to create Overrides record / or bad parameter in call",,"OVERRIDE",$T(+0)) Q:$Q "" Q
D MENU^ABSPOSO1(IEN)
Q:$Q IEN Q
OVERRIDR(RXI,RXR) ; alternative entry point - given RXI,RXR instead of IEN
N IEN
I $G(RXR) S IEN=$$GETIEN(RXI,RXR)
E S IEN=$$GETIEN(RXI)
S IEN=$$OVERRIDE(IEN)
Q:$Q IEN Q
GETIEN(RXI,RXR) ;EP - also called from claim construction
N IEN
I $G(RXR) S IEN=$P($G(^PSRX(RXI,1,RXR,9999999)),U,12)
E S IEN=$P($G(^PSRX(RXI,9999999)),U,12)
Q IEN
;
;
GETDUR(RXI,RXR) ;EP - also called from claim construction
;IHS/SD/lwj 8/20/02 NCPDP 5.1 changes - retrieve DUR/PPS pointer
; from the prescription file
N IEN
I $G(RXR) S IEN=$P($G(^PSRX(RXI,1,RXR,9999999)),U,13)
E S IEN=$P($G(^PSRX(RXI,9999999)),U,13)
Q IEN
;
GETDIAG(RXI,RXR) ;EP - called from ABSPOSII and ABSPOSQB
;Get DIAGNOSIS CODE POINTER from prescription file
N IEN
;I $G(RXR) S IEN=$P($G(^PSRX(RXI,1,RXR,9999999)),U,17)
;E S IEN=$P($G(^PSRX(RXI,9999999)),U,17)
;POINTERS REMOVED FROM PRESCRIPTION FILE
S IEN=0
S IEN=$O(^ABSP(9002313.491,"AC",RXI,IEN))
Q IEN
;
NEWOVER(IEN,DURIEN) ;EP IHS/SD/lwj 6/19/03 patch 6
; This routine was copied from OVERRIDE. It was
; adjusted to allow for entry of the usual overrides,
; plus the 5.1 DUR segment values.
;
; IEN points to file 9002313.511
; DURIEN points to file ^ABSP(9002313.473 DUR/PPS
; (We only have the EN when this is an edit to
; existing entries.)
;
;
N DIEN,CIEN,RIEN
S DIEN=$G(DURIEN)
;
I $G(IEN) D
. I '$D(^ABSP(9002313.511,IEN)) D ; it must have been winnowed
. . S IEN=$$NEW^ABSPOSO2
;
S:'$G(IEN) IEN=$$NEW^ABSPOSO2
I 'IEN D IMPOSS^ABSPOSUE("FM,P","TI","Failed to create Overrides record / or bad parameter in call",,"OVERRIDE",$T(+0)) Q:$Q "" Q
;
; Now create the DIEN - the difference between this and the IEN is that
; if they don't add anything in for the DIEN, we delete the whole record
;
I $G(DIEN) D
. I '$D(^ABSP(9002313.473,DIEN)) D ;must be there
. . S DIEN=$$NEW^ABSPOSD2
;
S:'$G(DIEN) DIEN=$$NEW^ABSPOSD2
;
I 'DIEN D IMPOSS^ABSPOSUE("FM,P","TI","Failed to create DUR rec",,"OVERRIDE",$T(+0)) Q:$Q "" Q
;
; call the menu for the user
;
S RIEN=IEN
S:$G(DIEN)'="" RIEN=RIEN_"^"_$G(DIEN)
;
D MENU^ABSPOSO1(RIEN)
;
;Last step - we need to verify we have values - otherwise
; let's get rid of the DUR record so it's not cluttering
; up the place
;
S DIEN=$$CHKDUR^ABSPOSD2(DIEN)
;
S RIEN=IEN
S:$G(DIEN)'="" RIEN=RIEN_"^"_$G(DIEN)
;
Q:$Q RIEN Q
ABSPOSO ; IHS/FCS/DRS - "O" is for Override NCPDP field values ; [ 08/20/2002 8:46 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,6,23**;JUN 21, 2001;Build 38
+2 ;
+3 ; File 9002313.511 ABSP NCPDP OVERRIDE
+4 ; It acts like an extension of the ^PSRX entry,
+5 ; though it's not tied to ^PSRX in any structural way.
+6 ; ^PSRX has a pointer to this file.
+7 ;
+8 ; IHS/SD/lwj 8/20/02 NCPDP 5.1 changes
+9 ; In 5.1 there is now some repeating fields/records. The DUR/PPS
+10 ; segment is a repeating segment (i.e. all the fields in this
+11 ; segment repeat.) Much like the values for the ABSP NCPDP
+12 ; Overrides are stored in a separate file, and referenced in
+13 ; the prescription file, the DUR/PPS values will be stored in
+14 ; a separate file (ABSP DUR/PPS) and simply referenced in the
+15 ; prescription file. For this reason, I'm adding the retrieval
+16 ; of the prescription DUR/PPS pointer in this routine to keep
+17 ; things consistent. (Site must have Outpatient Pharmacy V6.0
+18 ; Patch 4 loaded for the DUR/PPS field to be found.)
+19 ;
+20 ;---
+21 ;IHS/SD/lwj 6/19/03 Patch 6 - DUR segment for NCPDP 5.1
+22 ; We need to allow the pharmacist to override the DUR
+23 ; values as they exist in the 5.1 segment. New subroutine
+24 ; created to allow for both the incoming IEN value for the
+25 ; regular overrides, and the DIEN for the DUR segment
+26 ; overrides. (Subroutine will look much like OVERRIDE
+27 ; with the exception of the new parameters - new routine
+28 ; created to avoid conflict with existing code.)
+29 ;---
+30 ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
+31 ; Added new tag GETDIAG.
+32 QUIT
+33 ;
OVERRIDE(IEN) ; main entry point
+1 ; IEN points to file 9002313.511
+2 ; Sometimes we have IEN; sometimes we don't
+3 ; called from pharmacy package
+4 ; called from somewhere in POS, too
+5 IF $DATA(IEN)
Begin DoDot:1
+6 ; it must have been winnowed
IF '$DATA(^ABSP(9002313.511,IEN))
Begin DoDot:2
+7 SET IEN=$$NEW^ABSPOSO2
End DoDot:2
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF '$DATA(IEN)
SET IEN=$$NEW^ABSPOSO2
End DoDot:1
+10 IF 'IEN
DO IMPOSS^ABSPOSUE("FM,P","TI","Failed to create Overrides record / or bad parameter in call",,"OVERRIDE",$TEXT(+0))
IF $QUIT
QUIT ""
QUIT
+11 DO MENU^ABSPOSO1(IEN)
+12 IF $QUIT
QUIT IEN
QUIT
OVERRIDR(RXI,RXR) ; alternative entry point - given RXI,RXR instead of IEN
+1 NEW IEN
+2 IF $GET(RXR)
SET IEN=$$GETIEN(RXI,RXR)
+3 IF '$TEST
SET IEN=$$GETIEN(RXI)
+4 SET IEN=$$OVERRIDE(IEN)
+5 IF $QUIT
QUIT IEN
QUIT
GETIEN(RXI,RXR) ;EP - also called from claim construction
+1 NEW IEN
+2 IF $GET(RXR)
SET IEN=$PIECE($GET(^PSRX(RXI,1,RXR,9999999)),U,12)
+3 IF '$TEST
SET IEN=$PIECE($GET(^PSRX(RXI,9999999)),U,12)
+4 QUIT IEN
+5 ;
+6 ;
GETDUR(RXI,RXR) ;EP - also called from claim construction
+1 ;IHS/SD/lwj 8/20/02 NCPDP 5.1 changes - retrieve DUR/PPS pointer
+2 ; from the prescription file
+3 NEW IEN
+4 IF $GET(RXR)
SET IEN=$PIECE($GET(^PSRX(RXI,1,RXR,9999999)),U,13)
+5 IF '$TEST
SET IEN=$PIECE($GET(^PSRX(RXI,9999999)),U,13)
+6 QUIT IEN
+7 ;
GETDIAG(RXI,RXR) ;EP - called from ABSPOSII and ABSPOSQB
+1 ;Get DIAGNOSIS CODE POINTER from prescription file
+2 NEW IEN
+3 ;I $G(RXR) S IEN=$P($G(^PSRX(RXI,1,RXR,9999999)),U,17)
+4 ;E S IEN=$P($G(^PSRX(RXI,9999999)),U,17)
+5 ;POINTERS REMOVED FROM PRESCRIPTION FILE
+6 SET IEN=0
+7 SET IEN=$ORDER(^ABSP(9002313.491,"AC",RXI,IEN))
+8 QUIT IEN
+9 ;
NEWOVER(IEN,DURIEN) ;EP IHS/SD/lwj 6/19/03 patch 6
+1 ; This routine was copied from OVERRIDE. It was
+2 ; adjusted to allow for entry of the usual overrides,
+3 ; plus the 5.1 DUR segment values.
+4 ;
+5 ; IEN points to file 9002313.511
+6 ; DURIEN points to file ^ABSP(9002313.473 DUR/PPS
+7 ; (We only have the EN when this is an edit to
+8 ; existing entries.)
+9 ;
+10 ;
+11 NEW DIEN,CIEN,RIEN
+12 SET DIEN=$GET(DURIEN)
+13 ;
+14 IF $GET(IEN)
Begin DoDot:1
+15 ; it must have been winnowed
IF '$DATA(^ABSP(9002313.511,IEN))
Begin DoDot:2
+16 SET IEN=$$NEW^ABSPOSO2
End DoDot:2
End DoDot:1
+17 ;
+18 IF '$GET(IEN)
SET IEN=$$NEW^ABSPOSO2
+19 IF 'IEN
DO IMPOSS^ABSPOSUE("FM,P","TI","Failed to create Overrides record / or bad parameter in call",,"OVERRIDE",$TEXT(+0))
IF $QUIT
QUIT ""
QUIT
+20 ;
+21 ; Now create the DIEN - the difference between this and the IEN is that
+22 ; if they don't add anything in for the DIEN, we delete the whole record
+23 ;
+24 IF $GET(DIEN)
Begin DoDot:1
+25 ;must be there
IF '$DATA(^ABSP(9002313.473,DIEN))
Begin DoDot:2
+26 SET DIEN=$$NEW^ABSPOSD2
End DoDot:2
End DoDot:1
+27 ;
+28 IF '$GET(DIEN)
SET DIEN=$$NEW^ABSPOSD2
+29 ;
+30 IF 'DIEN
DO IMPOSS^ABSPOSUE("FM,P","TI","Failed to create DUR rec",,"OVERRIDE",$TEXT(+0))
IF $QUIT
QUIT ""
QUIT
+31 ;
+32 ; call the menu for the user
+33 ;
+34 SET RIEN=IEN
+35 IF $GET(DIEN)'=""
SET RIEN=RIEN_"^"_$GET(DIEN)
+36 ;
+37 DO MENU^ABSPOSO1(RIEN)
+38 ;
+39 ;Last step - we need to verify we have values - otherwise
+40 ; let's get rid of the DUR record so it's not cluttering
+41 ; up the place
+42 ;
+43 SET DIEN=$$CHKDUR^ABSPOSD2(DIEN)
+44 ;
+45 SET RIEN=IEN
+46 IF $GET(DIEN)'=""
SET RIEN=RIEN_"^"_$GET(DIEN)
+47 ;
+48 IF $QUIT
QUIT RIEN
QUIT
