BPS28PRE ;AITC/CKB - Pre-install for BPS*1.0*28 ;04/28/2020
;;1.0;E CLAIMS MGMT ENGINE;**28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*28 patch pre-install
;
Q
;
EN ; Pre-install functions are coded here.
;
D MES^XPDUTL(" Starting pre-install of BPS*1.0*28")
;
; Update descriptions in BPS NCPDP FIELD DEFS file #9002313.91
D FIELDS
;
D MES^XPDUTL(" Finished pre-install of BPS*1.0*28")
Q
;
FIELDS ; Update Fields Defs with new descriptions
N LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
D MES^XPDUTL(" - Updating BPS NCPDP FIELD DEFS")
S CNT=0
F LINE=1:1 S DATA=$P($T(UFLDS+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1),NAME=$P(DATA,";",2)
. S DIE=9002313.91
. S DA=$O(^BPSF(DIE,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM_",field: "_NAME) Q
. S DR=".03////^S X=NAME",CNT=CNT+1
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
D MES^XPDUTL(" ")
Q
;
UFLDS ; Fields to be updated
;;475;DUR/DUE CO-AGENT ID QUALIFIER
;;476;DUR/DUE CO-AGENT ID
;;544;DUR/DUE FREE TEXT MESSAGE
;;555;FRMULRY ALT ESTMTD PT COST SHR
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS28PRE 1250 printed Sep 23, 2025@19:26:43 Page 2
BPS28PRE ;AITC/CKB - Pre-install for BPS*1.0*28 ;04/28/2020
+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 ; MCCF EDI TAS ePharmacy - BPS*1*28 patch pre-install
+5 ;
+6 QUIT
+7 ;
EN ; Pre-install functions are coded here.
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install of BPS*1.0*28")
+3 ;
+4 ; Update descriptions in BPS NCPDP FIELD DEFS file #9002313.91
+5 DO FIELDS
+6 ;
+7 DO MES^XPDUTL(" Finished pre-install of BPS*1.0*28")
+8 QUIT
+9 ;
FIELDS ; Update Fields Defs with new descriptions
+1 NEW LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
+2 DO MES^XPDUTL(" - Updating BPS NCPDP FIELD DEFS")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(UFLDS+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+5 SET NUM=$PIECE(DATA,";",1)
SET NAME=$PIECE(DATA,";",2)
+6 SET DIE=9002313.91
+7 SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))
+8 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM_",field: "_NAME)
QUIT
+9 SET DR=".03////^S X=NAME"
SET CNT=CNT+1
+10 DO ^DIE
End DoDot:1
+11 DO MES^XPDUTL(" - "_CNT_" entries updated")
+12 DO MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
+13 DO MES^XPDUTL(" ")
+14 QUIT
+15 ;
UFLDS ; Fields to be updated
+1 ;;475;DUR/DUE CO-AGENT ID QUALIFIER
+2 ;;476;DUR/DUE CO-AGENT ID
+3 ;;544;DUR/DUE FREE TEXT MESSAGE
+4 ;;555;FRMULRY ALT ESTMTD PT COST SHR
+5 ;;
+6 ;
