BPSPRRX7 ;AITC/PD - ePharmacy secondary billing ;01-JUN-20
;;1.0;E CLAIMS MGMT ENGINE;**28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
ACTDTY(BPSRX,BPSRF,BPSDFN,BPSDOS) ; Active Duty Override
; Input:
; BPSRX (r) - Rx IEN
; BPSRF (r) - Rx Refill
; BPSDFN (r) - Patient IEN
; BPSDOS (r) - Rx Date of Service
;
I $G(BPSRX)="" Q
I $G(BPSRF)="" Q
I $G(BPSDFN)="" Q
I $G(BPSDOS)="" Q
;
N BPSDOSE,BPSEI,BPSELIG,BPSES,BPSICD,BPSSIG,BPSX,DFN,DIR,DUOUT
N VAEL,X1,Y
;
; Check Eligibility - Must be TRICARE dual eligible
; (Veteran and TRICARE)
;
S DFN=BPSDFN
D ELIG^VADPT
I 'VAEL(4) Q
S BPSELIG=$P(VAEL(1),"^",2)
S BPSX=""
F S BPSX=$O(VAEL(1,BPSX)) Q:BPSX="" D
. S BPSELIG=BPSELIG_$P(VAEL(1,BPSX),"^",2)
I BPSELIG'["TRICARE" Q
;
; Check Environmental Indicators
;
S BPSEI=0
K BPSICD
D GETS^DIQ(52.052311,1_","_BPSRX,"1;2;3;4;5;7;","I","BPSICD")
S BPSX="BPSICD(52)"
F S BPSX=$Q(@BPSX) Q:BPSX="" I @BPSX=1 S BPSEI=1
I BPSEI'=1 Q
;
; Check Date of Service
;
S BPSDOSE=$E(BPSDOS,4,5)_"/"_$E(BPSDOS,6,7)_"/"_(1700+$E(BPSDOS,1,3))
S DIR(0)="Y"
S DIR("A")="Was the patient Active Duty on "_BPSDOSE
S DIR("B")="No"
S DIR("?",1)="Enter Yes or No"
S DIR("?",2)="No - maintains the current Veteran status(es) and claim will not be"
S DIR("?",3)=" submitted"
S DIR("?",4)="Yes - overrides Veteran non-billable status(es) (e.g. SC, Combat, MST,"
S DIR("?",5)=" AO, etc.) and submits claim"
S DIR("?",6)=" "
S DIR("?")="An Electronic Signature code is required."
D ^DIR
I $G(DUOUT)!(Y="^")!('Y) D SETADO(BPSRX,BPSRF,0) Q
;
; Check Signature Code
;
; If no Electronic Signature code on file, display message and quit.
;
S BPSES=$$GET1^DIQ(200,DUZ,20.4)
I BPSES="" D D SETADO(BPSRX,BPSRF,0) Q
. W !,"Electronic Signature code is required."
;
; User has an Electronic Signature code on file.
; Prompt for Signature Code to verify.
;
S BPSSIG=0
SIGCD ; Signature Code
D SIG^XUSESIG
I 'BPSSIG&($G(X1)="") D G SIGCD
. W !!," *** Electronic Signature code is required. ***"
. S BPSSIG=1
I $G(X1)="" D SETADO(BPSRX,BPSRF,0) Q
;
D SETADO(BPSRX,BPSRF,1)
;
Q
;
SETADO(BPSRX,BPSRF,BPSAD) ; Set Active Duty Override Flag
;
; Input:
; BPSRX (r) - Rx IEN
; BPSRF (r) - Rx Refill
; BPSAD (r) - Acticve Duty Override; 0=No, 1=Yes
;
N DA,DIE,DR
;
; Original Fill
I 'BPSRF D
. S DA=BPSRX
. S DIE="^PSRX("
. S DR="32.4///"_+$G(BPSAD)
;
; Refill
I BPSRF D
. S DA=BPSRF
. S DA(1)=BPSRX
. S DIE="^PSRX("_BPSRX_",1,"
. S DR="24///"_+$G(BPSAD)
;
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSPRRX7 2689 printed Apr 09, 2024@20:56:15 Page 2
BPSPRRX7 ;AITC/PD - ePharmacy secondary billing ;01-JUN-20
+1 ;;1.0;E CLAIMS MGMT ENGINE;**28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
ACTDTY(BPSRX,BPSRF,BPSDFN,BPSDOS) ; Active Duty Override
+1 ; Input:
+2 ; BPSRX (r) - Rx IEN
+3 ; BPSRF (r) - Rx Refill
+4 ; BPSDFN (r) - Patient IEN
+5 ; BPSDOS (r) - Rx Date of Service
+6 ;
+7 IF $GET(BPSRX)=""
QUIT
+8 IF $GET(BPSRF)=""
QUIT
+9 IF $GET(BPSDFN)=""
QUIT
+10 IF $GET(BPSDOS)=""
QUIT
+11 ;
+12 NEW BPSDOSE,BPSEI,BPSELIG,BPSES,BPSICD,BPSSIG,BPSX,DFN,DIR,DUOUT
+13 NEW VAEL,X1,Y
+14 ;
+15 ; Check Eligibility - Must be TRICARE dual eligible
+16 ; (Veteran and TRICARE)
+17 ;
+18 SET DFN=BPSDFN
+19 DO ELIG^VADPT
+20 IF 'VAEL(4)
QUIT
+21 SET BPSELIG=$PIECE(VAEL(1),"^",2)
+22 SET BPSX=""
+23 FOR
SET BPSX=$ORDER(VAEL(1,BPSX))
if BPSX=""
QUIT
Begin DoDot:1
+24 SET BPSELIG=BPSELIG_$PIECE(VAEL(1,BPSX),"^",2)
End DoDot:1
+25 IF BPSELIG'["TRICARE"
QUIT
+26 ;
+27 ; Check Environmental Indicators
+28 ;
+29 SET BPSEI=0
+30 KILL BPSICD
+31 DO GETS^DIQ(52.052311,1_","_BPSRX,"1;2;3;4;5;7;","I","BPSICD")
+32 SET BPSX="BPSICD(52)"
+33 FOR
SET BPSX=$QUERY(@BPSX)
if BPSX=""
QUIT
IF @BPSX=1
SET BPSEI=1
+34 IF BPSEI'=1
QUIT
+35 ;
+36 ; Check Date of Service
+37 ;
+38 SET BPSDOSE=$EXTRACT(BPSDOS,4,5)_"/"_$EXTRACT(BPSDOS,6,7)_"/"_(1700+$EXTRACT(BPSDOS,1,3))
+39 SET DIR(0)="Y"
+40 SET DIR("A")="Was the patient Active Duty on "_BPSDOSE
+41 SET DIR("B")="No"
+42 SET DIR("?",1)="Enter Yes or No"
+43 SET DIR("?",2)="No - maintains the current Veteran status(es) and claim will not be"
+44 SET DIR("?",3)=" submitted"
+45 SET DIR("?",4)="Yes - overrides Veteran non-billable status(es) (e.g. SC, Combat, MST,"
+46 SET DIR("?",5)=" AO, etc.) and submits claim"
+47 SET DIR("?",6)=" "
+48 SET DIR("?")="An Electronic Signature code is required."
+49 DO ^DIR
+50 IF $GET(DUOUT)!(Y="^")!('Y)
DO SETADO(BPSRX,BPSRF,0)
QUIT
+51 ;
+52 ; Check Signature Code
+53 ;
+54 ; If no Electronic Signature code on file, display message and quit.
+55 ;
+56 SET BPSES=$$GET1^DIQ(200,DUZ,20.4)
+57 IF BPSES=""
Begin DoDot:1
+58 WRITE !,"Electronic Signature code is required."
End DoDot:1
DO SETADO(BPSRX,BPSRF,0)
QUIT
+59 ;
+60 ; User has an Electronic Signature code on file.
+61 ; Prompt for Signature Code to verify.
+62 ;
+63 SET BPSSIG=0
SIGCD ; Signature Code
+1 DO SIG^XUSESIG
+2 IF 'BPSSIG&($GET(X1)="")
Begin DoDot:1
+3 WRITE !!," *** Electronic Signature code is required. ***"
+4 SET BPSSIG=1
End DoDot:1
GOTO SIGCD
+5 IF $GET(X1)=""
DO SETADO(BPSRX,BPSRF,0)
QUIT
+6 ;
+7 DO SETADO(BPSRX,BPSRF,1)
+8 ;
+9 QUIT
+10 ;
SETADO(BPSRX,BPSRF,BPSAD) ; Set Active Duty Override Flag
+1 ;
+2 ; Input:
+3 ; BPSRX (r) - Rx IEN
+4 ; BPSRF (r) - Rx Refill
+5 ; BPSAD (r) - Acticve Duty Override; 0=No, 1=Yes
+6 ;
+7 NEW DA,DIE,DR
+8 ;
+9 ; Original Fill
+10 IF 'BPSRF
Begin DoDot:1
+11 SET DA=BPSRX
+12 SET DIE="^PSRX("
+13 SET DR="32.4///"_+$GET(BPSAD)
End DoDot:1
+14 ;
+15 ; Refill
+16 IF BPSRF
Begin DoDot:1
+17 SET DA=BPSRF
+18 SET DA(1)=BPSRX
+19 SET DIE="^PSRX("_BPSRX_",1,"
+20 SET DR="24///"_+$GET(BPSAD)
End DoDot:1
+21 ;
+22 DO ^DIE
+23 QUIT
