- 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 Jan 18, 2025@02:53:39 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