BPS24PRE ;AITC/PD - Pre-install for BPS*1.0*24 ;2/26/2018
;;1.0;E CLAIMS MGMT ENGINE;**24**;;Build 43
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
PRE ; Pre-install functions are coded here.
;
D MES^XPDUTL(" Starting pre-install of BPS*1.0*24")
;
; Perform the next two procedures only the first time this patch is loaded.
;
I '$$PATCH^XPDUTL("BPS*1.0*24") D
. ;
. ; Update descriptions in BPS NCPDP FIELD DEFS file #9002313.91
. D FIELDS
. ;
. ; Update segment name in BPS NCPDP SEGMENTS file #9002313.9
. D UPDSEG
. Q
;
D MES^XPDUTL(" Finished pre-install of BPS*1.0*24")
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(NFLDS+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
;
UPDSEG ; Update Segment with new
N DA,DIE,DR,NAME,ONAME
D MES^XPDUTL(" - Updating BPS NCPDP SEGMENTS")
S ONAME="RESPONSE COORDINATION OF BENEF"
S NAME="RESPONSE OTHER PAYERS"
S DIE=9002313.9
S DA=$O(^BPSF(DIE,"B",ONAME,""))
I 'DA D MES^XPDUTL(" - No IEN found for entry "_ONAME_",field: "_NAME) Q
S DR=".01////^S X=NAME"
D ^DIE
D MES^XPDUTL(" - entry updated")
D MES^XPDUTL(" - Done with BPS NCPDP SEGMENTS")
Q
;
NFLDS ; Fields to be updated
;;101;IIN NUMBER
;;348;BASIS OF CALC - REGULATORY FEE
;;349;BASIS OF CALC - % TAX
;;433;PATIENT PAID AMOUNT REPORTED
;;481;REGULATORY FEE AMT SUBMITTED
;;482;PERCENT TAX AMT SUBMITTED
;;483;PERCENT TAX RATE SUBMITTED
;;484;PERCENTAGE TAX BASIS SBMTTD
;;530;PREVIOUS DATE OF SERVICE
;;531;QTY OF PREVIOUS DISPENSING
;;551;FORMULARY ALT PRODUCT COUNT
;;552;FORMULARY ALT ID QUALIFIER
;;553;FORMULARY ALTERNATIVE ID
;;554;FORMULARY ALT INCENTIVE
;;555;FORMULARY ALT COST SHARE
;;556;FORMULARY ALT DESCRIPTION
;;557;PERCENT TAX EXEMPT INDICATOR
;;558;REGULATORY FEE AMOUNT PAID
;;559;PERCENTAGE TAX AMOUNT PAID
;;560;PERCENTAGE TAX RATE PAID
;;561;PERCENTAGE TAX BASIS PAID
;;568;PAYER/HEALTH PLAN ID QUALIFIER
;;569;PAYER/HEALTH PLAN ID
;;575;PATIENT PERCENTAGE TAX AMOUNT
;;A28;ADJUDICATED PROGRAM TYPE
;;A29;REPORTED ADJUDICATED PROG TYPE
;;B56;LAST KNOWN IIN NUMBER
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS24PRE 2642 printed Dec 13, 2024@01:50:29 Page 2
BPS24PRE ;AITC/PD - Pre-install for BPS*1.0*24 ;2/26/2018
+1 ;;1.0;E CLAIMS MGMT ENGINE;**24**;;Build 43
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
PRE ; Pre-install functions are coded here.
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install of BPS*1.0*24")
+3 ;
+4 ; Perform the next two procedures only the first time this patch is loaded.
+5 ;
+6 IF '$$PATCH^XPDUTL("BPS*1.0*24")
Begin DoDot:1
+7 ;
+8 ; Update descriptions in BPS NCPDP FIELD DEFS file #9002313.91
+9 DO FIELDS
+10 ;
+11 ; Update segment name in BPS NCPDP SEGMENTS file #9002313.9
+12 DO UPDSEG
+13 QUIT
End DoDot:1
+14 ;
+15 DO MES^XPDUTL(" Finished pre-install of BPS*1.0*24")
+16 QUIT
+17 ;
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(NFLDS+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 ;
UPDSEG ; Update Segment with new
+1 NEW DA,DIE,DR,NAME,ONAME
+2 DO MES^XPDUTL(" - Updating BPS NCPDP SEGMENTS")
+3 SET ONAME="RESPONSE COORDINATION OF BENEF"
+4 SET NAME="RESPONSE OTHER PAYERS"
+5 SET DIE=9002313.9
+6 SET DA=$ORDER(^BPSF(DIE,"B",ONAME,""))
+7 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_ONAME_",field: "_NAME)
QUIT
+8 SET DR=".01////^S X=NAME"
+9 DO ^DIE
+10 DO MES^XPDUTL(" - entry updated")
+11 DO MES^XPDUTL(" - Done with BPS NCPDP SEGMENTS")
+12 QUIT
+13 ;
NFLDS ; Fields to be updated
+1 ;;101;IIN NUMBER
+2 ;;348;BASIS OF CALC - REGULATORY FEE
+3 ;;349;BASIS OF CALC - % TAX
+4 ;;433;PATIENT PAID AMOUNT REPORTED
+5 ;;481;REGULATORY FEE AMT SUBMITTED
+6 ;;482;PERCENT TAX AMT SUBMITTED
+7 ;;483;PERCENT TAX RATE SUBMITTED
+8 ;;484;PERCENTAGE TAX BASIS SBMTTD
+9 ;;530;PREVIOUS DATE OF SERVICE
+10 ;;531;QTY OF PREVIOUS DISPENSING
+11 ;;551;FORMULARY ALT PRODUCT COUNT
+12 ;;552;FORMULARY ALT ID QUALIFIER
+13 ;;553;FORMULARY ALTERNATIVE ID
+14 ;;554;FORMULARY ALT INCENTIVE
+15 ;;555;FORMULARY ALT COST SHARE
+16 ;;556;FORMULARY ALT DESCRIPTION
+17 ;;557;PERCENT TAX EXEMPT INDICATOR
+18 ;;558;REGULATORY FEE AMOUNT PAID
+19 ;;559;PERCENTAGE TAX AMOUNT PAID
+20 ;;560;PERCENTAGE TAX RATE PAID
+21 ;;561;PERCENTAGE TAX BASIS PAID
+22 ;;568;PAYER/HEALTH PLAN ID QUALIFIER
+23 ;;569;PAYER/HEALTH PLAN ID
+24 ;;575;PATIENT PERCENTAGE TAX AMOUNT
+25 ;;A28;ADJUDICATED PROGRAM TYPE
+26 ;;A29;REPORTED ADJUDICATED PROG TYPE
+27 ;;B56;LAST KNOWN IIN NUMBER
+28 ;;
+29 ;
