| 1 | BPSJPAY ;BHAM ISC/DMB - e-Pharmacy Payer Sheet Code ;28-SEP-2004
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; Fileman access to VA(200) supported by DBIA 10060
|
|---|
| 5 | ;
|
|---|
| 6 | ; Must enter at tag STLIC
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | ; Subroutine to get State DEA and State Credentialing License Numbers
|
|---|
| 10 | STLIC(MEDN,PIEN,DOS) ;
|
|---|
| 11 | ; Input variable:
|
|---|
| 12 | ; MEDN - Index number indicating what medication is being processed (parameter)
|
|---|
| 13 | ; PIEN - Provider IEN for provider being processed (parameter)
|
|---|
| 14 | ; DOS - Service Date (parameter)
|
|---|
| 15 | ; U - Delimiter (System variable)
|
|---|
| 16 | ; Output variables
|
|---|
| 17 | ; State DEA License -
|
|---|
| 18 | ; BPS("RX",RX number,"Prescriber State DEA #",State Abbrev)=ID
|
|---|
| 19 | ; State Credentialling ID -
|
|---|
| 20 | ; BPS("RX",RX number,"Prescriber State License #",State Abbrev)=ID
|
|---|
| 21 | ;
|
|---|
| 22 | ; Check that first two parameters are not null
|
|---|
| 23 | I MEDN=""!(PIEN="") G STLIC2
|
|---|
| 24 | N IEN,X,STATE,ID,EXPDT,BPSVA,DISYS
|
|---|
| 25 | ;
|
|---|
| 26 | ; Get IDs from New Person File
|
|---|
| 27 | D GETS^DIQ(200,PIEN_",","54.1*;54.2*","I","BPSVA")
|
|---|
| 28 | ;
|
|---|
| 29 | ; State Issued DEA number
|
|---|
| 30 | S IEN="" F S IEN=$O(BPSVA(200.55,IEN)) Q:IEN="" D
|
|---|
| 31 | . S STATE=$G(BPSVA(200.55,IEN,.01,"I"))
|
|---|
| 32 | . S ID=$G(BPSVA(200.55,IEN,1,"I"))
|
|---|
| 33 | . I STATE=""!(ID="") Q
|
|---|
| 34 | . S STATE=$P($G(^DIC(5,STATE,0)),"^",2)
|
|---|
| 35 | . I STATE="" Q
|
|---|
| 36 | . S BPS("RX",MEDN,"Prescriber State DEA #",STATE)=ID
|
|---|
| 37 | ;
|
|---|
| 38 | ; Get State Credentialing License Number
|
|---|
| 39 | I DOS="" G STLIC2
|
|---|
| 40 | S IEN="" F S IEN=$O(BPSVA(200.541,IEN)) Q:IEN="" D
|
|---|
| 41 | . S STATE=$G(BPSVA(200.541,IEN,.01,"I"))
|
|---|
| 42 | . S ID=$G(BPSVA(200.541,IEN,1,"I"))
|
|---|
| 43 | . S EXPDT=$G(BPSVA(200.541,IEN,2,"I"))
|
|---|
| 44 | . I STATE=""!(ID="") Q
|
|---|
| 45 | . ; If there is a expiration date, check to see if the license is valid
|
|---|
| 46 | . ; as of the service date
|
|---|
| 47 | . I EXPDT,EXPDT+17000000<DOS Q
|
|---|
| 48 | . S STATE=$P($G(^DIC(5,STATE,0)),"^",2)
|
|---|
| 49 | . I STATE="" Q
|
|---|
| 50 | . S BPS("RX",MEDN,"Prescriber State License #",STATE)=ID
|
|---|
| 51 | STLIC2 Q
|
|---|
