ABSPOSIH ; IHS/FCS/DRS - NCPDP 5.1 DUR Overrides form ; [ 06/03/2002 4:40 AM ]
;;1.0;PHARMACY POINT OF SALE;**6,48**;JUN 21, 2001;Build 38
; Property of Indian Health Service
;
Q
PREINIT ;EP - check for existing record
; This is the pre-init routine tied to the
; ABSP INPUT 5.1 DUR INPUT block on the ABSP Input Data screen
; This is used during the creation of the "new" claim from
; within POS (called from the "USER" screen) to capture
; NCPDP 5.1 DUR override values.
;
;
N RXI,RXR,OVERDUR,FDA,STRING
;
; get the prescription information
S RXI=$$GET^DDSVAL(DIE,.DA,1.01) ;RX IEN
S RXR=$$GET^DDSVAL(DIE,.DA,1.02) ;RX Refill IEN
S OVERDUR=""
;
Q:$G(RXI)="" ;no pres - get out
;
S OVERDUR=$$GETDUR^ABSPOSO(RXI,RXR) ;get dur override number
;
I $G(OVERDUR)'="" D ;override exists
. S STRING(1)="Will add override from IEN RX "_RXI ;msg on scrn
. S:+RXR STRING(1)=STRING(1)_" IEN Refill "_RXR
. D HLP^DDSUTL(.STRING) ;displays what is happening
. ;
I $G(OVERDUR)="" D ;override doesn't exist yet
. S OVERDUR=$$NEW^ABSPOSD2
. S STRING(1)="Will add new Override "_OVERDUR
. D HLP^DDSUTL(.STRING)
;
; create empty entries for adding new data
D NEWSUB^ABSPOSD2(OVERDUR)
;
; now- update the input data file and the prescription
D UPDRX(RXI,RXR,OVERDUR)
D PUT^DDSVAL(DIE,.DA,1.13,OVERDUR,,"I")
;
; theres a chance they won't file the claim - hold on to the
; dur so we can clean up empty records if its not filed
;
S ^TMP("ABSPOSIH",$J,OVERDUR)=RXI_"^"_RXR
;
Q
;
CLNDUR(IEN,ENTRY) ;EP - clean up the DUR file of empty entries
; and update the RX file when no override information
; was actually entered for the 5.1 DUR segment.
; This routine called from ABSPOSIZ - subroutine FILE
;
;
N OVERDUR,DATAREC
;
S DATAREC=$G(^ABSP(9002313.51,IEN,2,ENTRY,1))
;
S OVERDUR=$P(DATAREC,"^",10)
Q:OVERDUR="" ;IHS/SD/lwj 8/4/03 just quit
;
S RXI=$P(DATAREC,"^")
S RXR=$P(DATAREC,"^",2)
;
S OVERDUR=$$CHKDUR^ABSPOSD2(OVERDUR) ;good data input?
;
I $G(OVERDUR)="" D ;nothing input - delete it
. D UPDRX(RXI,RXR,OVERDUR)
. N FDA,ZERR ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
. S FDA(9002313.51,ENTRY_","_IEN_",",1.13)=OVERDUR
. D FILE^DIE("","FDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
. I $D(ZERR) D LOG^ABSPOSL2("CLNDUR^ABSPOSIH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
;
Q
;
UPDRX(RXI,RXR,OVERDUR) ; update the prescription with the DUR 5.1 information
; and the ABSP Data Input file with the appropriate value
;
N FDA,ZERR ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
;
; OVERDUR set within POSTINIT
; RXR - rx refill IEN
; RXI - rx IEN
; OVERDUR - NCPDP 5.1 DUR segment pointer
;
I '+$G(RXR) D ;NOT a refill
. S FDA(52,RXI_",",9999999.13)=OVERDUR
. D FILE^DIE("","FDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
. I $D(ZERR) D LOG^ABSPOSL2("UPDRX+13^ABSPOSIH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
;
I +$G(RXR) D ;refill
. S FDA(52.1,RXR_","_RXI_",",9999999.13)=OVERDUR
. D FILE^DIE("","FDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
. I $D(ZERR) D LOG^ABSPOSL2("UPDRX+18^ABSPOSIH",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
;
Q
;
NOCLM ;EP - called from ABSPOSI when the claims are NOT filed - we
; still must clean up the empty records if they called upon
; the DUR overrides
;
N DURIEN,CLNDUR
S DURIEN=0
;
F S DURIEN=$O(^TMP("ABSPOSIH",$J,DURIEN)) Q:DURIEN="" D
. N CLNDUR,RXI,RXR,DURREC
. S DURREC=$G(^TMP("ABSPOSIH",$J,DURIEN))
. S RXI=$P(DURREC,"^") ;internal RX number
. S RXR=$P(DURREC,"^",2) ;refill number
. S CLNDUR=$$CHKDUR^ABSPOSD2(DURIEN)
. D:$G(CLNDUR)="" UPDRX(RXI,RXR,CLNDUR)
;
;
Q
ABSPOSIH ; IHS/FCS/DRS - NCPDP 5.1 DUR Overrides form ; [ 06/03/2002 4:40 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**6,48**;JUN 21, 2001;Build 38
+2 ; Property of Indian Health Service
+3 ;
+4 QUIT
PREINIT ;EP - check for existing record
+1 ; This is the pre-init routine tied to the
+2 ; ABSP INPUT 5.1 DUR INPUT block on the ABSP Input Data screen
+3 ; This is used during the creation of the "new" claim from
+4 ; within POS (called from the "USER" screen) to capture
+5 ; NCPDP 5.1 DUR override values.
+6 ;
+7 ;
+8 NEW RXI,RXR,OVERDUR,FDA,STRING
+9 ;
+10 ; get the prescription information
+11 ;RX IEN
SET RXI=$$GET^DDSVAL(DIE,.DA,1.01)
+12 ;RX Refill IEN
SET RXR=$$GET^DDSVAL(DIE,.DA,1.02)
+13 SET OVERDUR=""
+14 ;
+15 ;no pres - get out
IF $GET(RXI)=""
QUIT
+16 ;
+17 ;get dur override number
SET OVERDUR=$$GETDUR^ABSPOSO(RXI,RXR)
+18 ;
+19 ;override exists
IF $GET(OVERDUR)'=""
Begin DoDot:1
+20 ;msg on scrn
SET STRING(1)="Will add override from IEN RX "_RXI
+21 IF +RXR
SET STRING(1)=STRING(1)_" IEN Refill "_RXR
+22 ;displays what is happening
DO HLP^DDSUTL(.STRING)
+23 ;
End DoDot:1
+24 ;override doesn't exist yet
IF $GET(OVERDUR)=""
Begin DoDot:1
+25 SET OVERDUR=$$NEW^ABSPOSD2
+26 SET STRING(1)="Will add new Override "_OVERDUR
+27 DO HLP^DDSUTL(.STRING)
End DoDot:1
+28 ;
+29 ; create empty entries for adding new data
+30 DO NEWSUB^ABSPOSD2(OVERDUR)
+31 ;
+32 ; now- update the input data file and the prescription
+33 DO UPDRX(RXI,RXR,OVERDUR)
+34 DO PUT^DDSVAL(DIE,.DA,1.13,OVERDUR,,"I")
+35 ;
+36 ; theres a chance they won't file the claim - hold on to the
+37 ; dur so we can clean up empty records if its not filed
+38 ;
+39 SET ^TMP("ABSPOSIH",$JOB,OVERDUR)=RXI_"^"_RXR
+40 ;
+41 QUIT
+42 ;
CLNDUR(IEN,ENTRY) ;EP - clean up the DUR file of empty entries
+1 ; and update the RX file when no override information
+2 ; was actually entered for the 5.1 DUR segment.
+3 ; This routine called from ABSPOSIZ - subroutine FILE
+4 ;
+5 ;
+6 NEW OVERDUR,DATAREC
+7 ;
+8 SET DATAREC=$GET(^ABSP(9002313.51,IEN,2,ENTRY,1))
+9 ;
+10 SET OVERDUR=$PIECE(DATAREC,"^",10)
+11 ;IHS/SD/lwj 8/4/03 just quit
IF OVERDUR=""
QUIT
+12 ;
+13 SET RXI=$PIECE(DATAREC,"^")
+14 SET RXR=$PIECE(DATAREC,"^",2)
+15 ;
+16 ;good data input?
SET OVERDUR=$$CHKDUR^ABSPOSD2(OVERDUR)
+17 ;
+18 ;nothing input - delete it
IF $GET(OVERDUR)=""
Begin DoDot:1
+19 DO UPDRX(RXI,RXR,OVERDUR)
+20 ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
NEW FDA,ZERR
+21 SET FDA(9002313.51,ENTRY_","_IEN_",",1.13)=OVERDUR
+22 ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
DO FILE^DIE("","FDA","ZERR")
+23 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("CLNDUR^ABSPOSIH",.ZERR)
End DoDot:1
+24 ;
+25 QUIT
+26 ;
UPDRX(RXI,RXR,OVERDUR) ; update the prescription with the DUR 5.1 information
+1 ; and the ABSP Data Input file with the appropriate value
+2 ;
+3 ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
NEW FDA,ZERR
+4 ;
+5 ; OVERDUR set within POSTINIT
+6 ; RXR - rx refill IEN
+7 ; RXI - rx IEN
+8 ; OVERDUR - NCPDP 5.1 DUR segment pointer
+9 ;
+10 ;NOT a refill
IF '+$GET(RXR)
Begin DoDot:1
+11 SET FDA(52,RXI_",",9999999.13)=OVERDUR
+12 ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
DO FILE^DIE("","FDA","ZERR")
+13 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("UPDRX+13^ABSPOSIH",.ZERR)
End DoDot:1
+14 ;
+15 ;refill
IF +$GET(RXR)
Begin DoDot:1
+16 SET FDA(52.1,RXR_","_RXI_",",9999999.13)=OVERDUR
+17 ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
DO FILE^DIE("","FDA","ZERR")
+18 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("UPDRX+18^ABSPOSIH",.ZERR)
End DoDot:1
+19 ;
+20 QUIT
+21 ;
NOCLM ;EP - called from ABSPOSI when the claims are NOT filed - we
+1 ; still must clean up the empty records if they called upon
+2 ; the DUR overrides
+3 ;
+4 NEW DURIEN,CLNDUR
+5 SET DURIEN=0
+6 ;
+7 FOR
SET DURIEN=$ORDER(^TMP("ABSPOSIH",$JOB,DURIEN))
IF DURIEN=""
QUIT
Begin DoDot:1
+8 NEW CLNDUR,RXI,RXR,DURREC
+9 SET DURREC=$GET(^TMP("ABSPOSIH",$JOB,DURIEN))
+10 ;internal RX number
SET RXI=$PIECE(DURREC,"^")
+11 ;refill number
SET RXR=$PIECE(DURREC,"^",2)
+12 SET CLNDUR=$$CHKDUR^ABSPOSD2(DURIEN)
+13 IF $GET(CLNDUR)=""
DO UPDRX(RXI,RXR,CLNDUR)
End DoDot:1
+14 ;
+15 ;
+16 QUIT
