Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSPRRX7

BPSPRRX7.m

Go to the documentation of this file.
  1. BPSPRRX7 ;AITC/PD - ePharmacy secondary billing ;01-JUN-20
  1. ;;1.0;E CLAIMS MGMT ENGINE;**28**;JUN 2004;Build 22
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. ACTDTY(BPSRX,BPSRF,BPSDFN,BPSDOS) ; Active Duty Override
  1. ; Input:
  1. ; BPSRX (r) - Rx IEN
  1. ; BPSRF (r) - Rx Refill
  1. ; BPSDFN (r) - Patient IEN
  1. ; BPSDOS (r) - Rx Date of Service
  1. ;
  1. I $G(BPSRX)="" Q
  1. I $G(BPSRF)="" Q
  1. I $G(BPSDFN)="" Q
  1. I $G(BPSDOS)="" Q
  1. ;
  1. N BPSDOSE,BPSEI,BPSELIG,BPSES,BPSICD,BPSSIG,BPSX,DFN,DIR,DUOUT
  1. N VAEL,X1,Y
  1. ;
  1. ; Check Eligibility - Must be TRICARE dual eligible
  1. ; (Veteran and TRICARE)
  1. ;
  1. S DFN=BPSDFN
  1. D ELIG^VADPT
  1. I 'VAEL(4) Q
  1. S BPSELIG=$P(VAEL(1),"^",2)
  1. S BPSX=""
  1. F S BPSX=$O(VAEL(1,BPSX)) Q:BPSX="" D
  1. . S BPSELIG=BPSELIG_$P(VAEL(1,BPSX),"^",2)
  1. I BPSELIG'["TRICARE" Q
  1. ;
  1. ; Check Environmental Indicators
  1. ;
  1. S BPSEI=0
  1. K BPSICD
  1. D GETS^DIQ(52.052311,1_","_BPSRX,"1;2;3;4;5;7;","I","BPSICD")
  1. S BPSX="BPSICD(52)"
  1. F S BPSX=$Q(@BPSX) Q:BPSX="" I @BPSX=1 S BPSEI=1
  1. I BPSEI'=1 Q
  1. ;
  1. ; Check Date of Service
  1. ;
  1. S BPSDOSE=$E(BPSDOS,4,5)_"/"_$E(BPSDOS,6,7)_"/"_(1700+$E(BPSDOS,1,3))
  1. S DIR(0)="Y"
  1. S DIR("A")="Was the patient Active Duty on "_BPSDOSE
  1. S DIR("B")="No"
  1. S DIR("?",1)="Enter Yes or No"
  1. S DIR("?",2)="No - maintains the current Veteran status(es) and claim will not be"
  1. S DIR("?",3)=" submitted"
  1. S DIR("?",4)="Yes - overrides Veteran non-billable status(es) (e.g. SC, Combat, MST,"
  1. S DIR("?",5)=" AO, etc.) and submits claim"
  1. S DIR("?",6)=" "
  1. S DIR("?")="An Electronic Signature code is required."
  1. D ^DIR
  1. I $G(DUOUT)!(Y="^")!('Y) D SETADO(BPSRX,BPSRF,0) Q
  1. ;
  1. ; Check Signature Code
  1. ;
  1. ; If no Electronic Signature code on file, display message and quit.
  1. ;
  1. S BPSES=$$GET1^DIQ(200,DUZ,20.4)
  1. I BPSES="" D D SETADO(BPSRX,BPSRF,0) Q
  1. . W !,"Electronic Signature code is required."
  1. ;
  1. ; User has an Electronic Signature code on file.
  1. ; Prompt for Signature Code to verify.
  1. ;
  1. S BPSSIG=0
  1. SIGCD ; Signature Code
  1. D SIG^XUSESIG
  1. I 'BPSSIG&($G(X1)="") D G SIGCD
  1. . W !!," *** Electronic Signature code is required. ***"
  1. . S BPSSIG=1
  1. I $G(X1)="" D SETADO(BPSRX,BPSRF,0) Q
  1. ;
  1. D SETADO(BPSRX,BPSRF,1)
  1. ;
  1. Q
  1. ;
  1. SETADO(BPSRX,BPSRF,BPSAD) ; Set Active Duty Override Flag
  1. ;
  1. ; Input:
  1. ; BPSRX (r) - Rx IEN
  1. ; BPSRF (r) - Rx Refill
  1. ; BPSAD (r) - Acticve Duty Override; 0=No, 1=Yes
  1. ;
  1. N DA,DIE,DR
  1. ;
  1. ; Original Fill
  1. I 'BPSRF D
  1. . S DA=BPSRX
  1. . S DIE="^PSRX("
  1. . S DR="32.4///"_+$G(BPSAD)
  1. ;
  1. ; Refill
  1. I BPSRF D
  1. . S DA=BPSRF
  1. . S DA(1)=BPSRX
  1. . S DIE="^PSRX("_BPSRX_",1,"
  1. . S DR="24///"_+$G(BPSAD)
  1. ;
  1. D ^DIE
  1. Q