BPS40PRE ;AITC/PED - Pre-install routine for BPS*1*40 ;02/20/2025
;;1.0;E CLAIMS MGMT ENGINE;**40**;JUN 2004;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*40 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*40")
;
D BPSNPI
;
D MES^XPDUTL(" Finished pre-install of BPS*1*40")
;
Q
;
BPSNPI ; BPS Pharmacy
; Loop through BPS Pharmacies file and create a report
; showing Pharmacy Name, Status, NPI, and BPS Pharmacy
; for CS. The report will be emailed to the ePharmacy
; developers to verify all BPS Pharmacies have an NPI.
;
N BPSSITENAME,BPSSITENUMBER,BPSVASITE,BPSX,BPSXI,CS,DATA,DIFROM
N ISSUE,NPI,PHAR,PHARM,SPACE,STATUS,VA200,XMDUZ,XMSUB,XMTEXT,XMY
;
D BMES^XPDUTL(" Check BPS PHARMACIES File")
;
S BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
S BPSSITENAME=$P(BPSVASITE,"^")
S BPSSITENUMBER=$P(BPSVASITE,"^",2)
S XMSUB="BPS Pharmacy NPI Report"
S XMDUZ=BPSSITENUMBER_" - "_BPSSITENAME
I '$$PROD^XUPROD(1) D
. S XMY(DUZ)=""
. S VA200=$O(^VA(200,"B","DEVINE,PAUL","")) I VA200'="" S XMY(VA200)=""
. S VA200=$O(^VA(200,"B","DAWSON,MARK R","")) I VA200'="" S XMY(VA200)=""
. S VA200=$O(^VA(200,"B","HOLM,HEIDI","")) I VA200'="" S XMY(VA200)=""
I $$PROD^XUPROD(1) D
. S XMY("Paul.Devine@domain.ext")=""
. S XMY("Mark.Dawson3@domain.ext")=""
. S XMY("Heidi.Holm@domain.ext")=""
S XMTEXT="BPSX("
;
S BPSX(1)=""
S BPSX(2)="BPS Pharmacy Status NPI CS Pharmacy"
S BPSX(3)="-------------------------------------------------------------------------------"
;
S ISSUE=0
S BPSXI=3
F I=1:1:79 S SPACE=$G(SPACE)_" "
S PHAR=0
F S PHAR=$O(^BPS(9002313.56,PHAR)) Q:'PHAR D
. S PHARM=$$GET1^DIQ(9002313.56,PHAR,.01)
. S PHARM=PHARM_$E(SPACE,1,(39-$L(PHARM)))
. S STATUS=$E($$GET1^DIQ(9002313.56,PHAR,.1),1)
. S STATUS=STATUS_" "
. S NPI=$$GET1^DIQ(9002313.56,PHAR,41.01)
. I NPI="" S ISSUE=1
. S NPI=NPI_$E(SPACE,1,(13-$L(NPI)))
. S CS=$$GET1^DIQ(9002313.56,PHAR,2)
. I CS="" S CS="N/A"
. S CS=$E(CS,1,23)
. S DATA=PHARM_STATUS_NPI_CS
. S BPSXI=BPSXI+1
. S BPSX(BPSXI)=DATA
;
I ISSUE S XMSUB="*** "_XMSUB
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS40PRE 2297 printed Sep 23, 2025@19:26:52 Page 2
BPS40PRE ;AITC/PED - Pre-install routine for BPS*1*40 ;02/20/2025
+1 ;;1.0;E CLAIMS MGMT ENGINE;**40**;JUN 2004;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*40 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*40")
+3 ;
+4 DO BPSNPI
+5 ;
+6 DO MES^XPDUTL(" Finished pre-install of BPS*1*40")
+7 ;
+8 QUIT
+9 ;
BPSNPI ; BPS Pharmacy
+1 ; Loop through BPS Pharmacies file and create a report
+2 ; showing Pharmacy Name, Status, NPI, and BPS Pharmacy
+3 ; for CS. The report will be emailed to the ePharmacy
+4 ; developers to verify all BPS Pharmacies have an NPI.
+5 ;
+6 NEW BPSSITENAME,BPSSITENUMBER,BPSVASITE,BPSX,BPSXI,CS,DATA,DIFROM
+7 NEW ISSUE,NPI,PHAR,PHARM,SPACE,STATUS,VA200,XMDUZ,XMSUB,XMTEXT,XMY
+8 ;
+9 DO BMES^XPDUTL(" Check BPS PHARMACIES File")
+10 ;
+11 SET BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
+12 SET BPSSITENAME=$PIECE(BPSVASITE,"^")
+13 SET BPSSITENUMBER=$PIECE(BPSVASITE,"^",2)
+14 SET XMSUB="BPS Pharmacy NPI Report"
+15 SET XMDUZ=BPSSITENUMBER_" - "_BPSSITENAME
+16 IF '$$PROD^XUPROD(1)
Begin DoDot:1
+17 SET XMY(DUZ)=""
+18 SET VA200=$ORDER(^VA(200,"B","DEVINE,PAUL",""))
IF VA200'=""
SET XMY(VA200)=""
+19 SET VA200=$ORDER(^VA(200,"B","DAWSON,MARK R",""))
IF VA200'=""
SET XMY(VA200)=""
+20 SET VA200=$ORDER(^VA(200,"B","HOLM,HEIDI",""))
IF VA200'=""
SET XMY(VA200)=""
End DoDot:1
+21 IF $$PROD^XUPROD(1)
Begin DoDot:1
+22 SET XMY("Paul.Devine@domain.ext")=""
+23 SET XMY("Mark.Dawson3@domain.ext")=""
+24 SET XMY("Heidi.Holm@domain.ext")=""
End DoDot:1
+25 SET XMTEXT="BPSX("
+26 ;
+27 SET BPSX(1)=""
+28 SET BPSX(2)="BPS Pharmacy Status NPI CS Pharmacy"
+29 SET BPSX(3)="-------------------------------------------------------------------------------"
+30 ;
+31 SET ISSUE=0
+32 SET BPSXI=3
+33 FOR I=1:1:79
SET SPACE=$GET(SPACE)_" "
+34 SET PHAR=0
+35 FOR
SET PHAR=$ORDER(^BPS(9002313.56,PHAR))
if 'PHAR
QUIT
Begin DoDot:1
+36 SET PHARM=$$GET1^DIQ(9002313.56,PHAR,.01)
+37 SET PHARM=PHARM_$EXTRACT(SPACE,1,(39-$LENGTH(PHARM)))
+38 SET STATUS=$EXTRACT($$GET1^DIQ(9002313.56,PHAR,.1),1)
+39 SET STATUS=STATUS_" "
+40 SET NPI=$$GET1^DIQ(9002313.56,PHAR,41.01)
+41 IF NPI=""
SET ISSUE=1
+42 SET NPI=NPI_$EXTRACT(SPACE,1,(13-$LENGTH(NPI)))
+43 SET CS=$$GET1^DIQ(9002313.56,PHAR,2)
+44 IF CS=""
SET CS="N/A"
+45 SET CS=$EXTRACT(CS,1,23)
+46 SET DATA=PHARM_STATUS_NPI_CS
+47 SET BPSXI=BPSXI+1
+48 SET BPSX(BPSXI)=DATA
End DoDot:1
+49 ;
+50 IF ISSUE
SET XMSUB="*** "_XMSUB
+51 DO ^XMD
+52 ;
+53 QUIT
