BPS27PRE ;AITC/PD/CKB - Pre-install for BPS*1.0*27 ;10/08/2019
;;1.0;E CLAIMS MGMT ENGINE;**27**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*27 patch pre-install
;
Q
;
EN ; Pre-install functions are coded here.
;
D MES^XPDUTL(" Starting pre-install of BPS*1.0*27")
D MES^XPDUTL(" ")
;
; Update descriptions in BPS NCPDP FIELD DEFS file #9002313.91.
;
D FIELDS
;
; Update fields .02 and .03 in BPS NCPDP PATIENT RESIDENCE CODE.
;
D PTRES
;
; Update Reject Code explanation in file #9002313.93.
;
D REJECT
;
; Update Submission Clarification Code description in file #9002313.25.
;
D SCC
;
D MES^XPDUTL(" Finished pre-install of BPS*1.0*27")
;
Q
;
FIELDS ; Update Fields Defs with new descriptions
N CNT,DA,DATA,DIE,DR,LINE,NAME,NUM,STDNAME
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)
. 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 CNT=CNT+1
. S NAME=$P(DATA,";",2)
. S STDNAME=$P(DATA,";",3)
. S DR=".03////"_NAME_";1.01////"_STDNAME
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
D MES^XPDUTL(" ")
Q
;
NFLDS ; Updated Fields
;;546;REJECT FIELD OCCURRENCE INDCTR;REJECT FIELD OCCURRENCE INDICATOR
;;
;
PTRES ;
; Update Patient Residence Codes with new explanations
N BRIEF,CNT,DA,DATA,DIE,DR,FULL,LINE,NUM
D MES^XPDUTL(" - Updating BPS NCPDP PATIENT RESIDENCE CODE")
S CNT=0
F LINE=1:1 S DATA=$P($T(PTRES1+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S DIE=9002313.27
. S DA=$O(^BPS(DIE,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. S CNT=CNT+1
. S BRIEF=$P(DATA,";",2)
. S FULL=$P(DATA,";",3)
. S DR=".02////"_BRIEF_";.03///"_FULL
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP PATIENT RESIDENCE CODE")
D MES^XPDUTL(" ")
Q
;
PTRES1 ; Updated Patient Residence explanations
;;15;PRISON/CORRECTIONAL FACILITY;Prison/Correctional Facility
;;
;
REJECT ;
; Update Reject Codes with new explanation
N CNT,DA,DATA,DIE,DR,LINE,NAME,NUM
D MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
S CNT=0
F LINE=1:1 S DATA=$P($T(URJCT+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S DIE=9002313.93
. S DA=$O(^BPSF(DIE,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. S CNT=CNT+1
. S NAME=$P(DATA,";",2)
. S DR=".02////"_NAME
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
D MES^XPDUTL(" ")
Q
;
URJCT ; Updated reject explanation
;;650;DOS More Than 60 Days From CII Dt Rx Written for LTC/Terminally Ill Pt
;;
;
SCC ; Update Submission Clarification Code with new explanations
N CNT,DA,DATA,DIE,DR,LINE,NAME,NUM
D MES^XPDUTL(" - Updating BPS NCPDP CLARIFICATION CODES")
S CNT=0
F LINE=1:1 S DATA=$P($T(UPDSCC+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S DIE=9002313.25
. S DA=$O(^BPS(DIE,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. S CNT=CNT+1
. S NAME=$P(DATA,";",2)
. S DR=".02////"_NAME
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP CLARIFICATION CODES")
D MES^XPDUTL(" ")
Q
;
UPDSCC ; Updated clarification code description
;;47;OTHER SHORTENED DAYS SUPPLY
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS27PRE 3707 printed Apr 09, 2024@20:58:17 Page 2
BPS27PRE ;AITC/PD/CKB - Pre-install for BPS*1.0*27 ;10/08/2019
+1 ;;1.0;E CLAIMS MGMT ENGINE;**27**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*27 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*27")
+3 DO MES^XPDUTL(" ")
+4 ;
+5 ; Update descriptions in BPS NCPDP FIELD DEFS file #9002313.91.
+6 ;
+7 DO FIELDS
+8 ;
+9 ; Update fields .02 and .03 in BPS NCPDP PATIENT RESIDENCE CODE.
+10 ;
+11 DO PTRES
+12 ;
+13 ; Update Reject Code explanation in file #9002313.93.
+14 ;
+15 DO REJECT
+16 ;
+17 ; Update Submission Clarification Code description in file #9002313.25.
+18 ;
+19 DO SCC
+20 ;
+21 DO MES^XPDUTL(" Finished pre-install of BPS*1.0*27")
+22 ;
+23 QUIT
+24 ;
FIELDS ; Update Fields Defs with new descriptions
+1 NEW CNT,DA,DATA,DIE,DR,LINE,NAME,NUM,STDNAME
+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)
+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 CNT=CNT+1
+10 SET NAME=$PIECE(DATA,";",2)
+11 SET STDNAME=$PIECE(DATA,";",3)
+12 SET DR=".03////"_NAME_";1.01////"_STDNAME
+13 DO ^DIE
End DoDot:1
+14 DO MES^XPDUTL(" - "_CNT_" entries updated")
+15 DO MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
+16 DO MES^XPDUTL(" ")
+17 QUIT
+18 ;
NFLDS ; Updated Fields
+1 ;;546;REJECT FIELD OCCURRENCE INDCTR;REJECT FIELD OCCURRENCE INDICATOR
+2 ;;
+3 ;
PTRES ;
+1 ; Update Patient Residence Codes with new explanations
+2 NEW BRIEF,CNT,DA,DATA,DIE,DR,FULL,LINE,NUM
+3 DO MES^XPDUTL(" - Updating BPS NCPDP PATIENT RESIDENCE CODE")
+4 SET CNT=0
+5 FOR LINE=1:1
SET DATA=$PIECE($TEXT(PTRES1+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+6 SET NUM=$PIECE(DATA,";",1)
+7 SET DIE=9002313.27
+8 SET DA=$ORDER(^BPS(DIE,"B",NUM,""))
+9 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+10 SET CNT=CNT+1
+11 SET BRIEF=$PIECE(DATA,";",2)
+12 SET FULL=$PIECE(DATA,";",3)
+13 SET DR=".02////"_BRIEF_";.03///"_FULL
+14 DO ^DIE
End DoDot:1
+15 DO MES^XPDUTL(" - "_CNT_" entries updated")
+16 DO MES^XPDUTL(" - Done with BPS NCPDP PATIENT RESIDENCE CODE")
+17 DO MES^XPDUTL(" ")
+18 QUIT
+19 ;
PTRES1 ; Updated Patient Residence explanations
+1 ;;15;PRISON/CORRECTIONAL FACILITY;Prison/Correctional Facility
+2 ;;
+3 ;
REJECT ;
+1 ; Update Reject Codes with new explanation
+2 NEW CNT,DA,DATA,DIE,DR,LINE,NAME,NUM
+3 DO MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
+4 SET CNT=0
+5 FOR LINE=1:1
SET DATA=$PIECE($TEXT(URJCT+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+6 SET NUM=$PIECE(DATA,";",1)
+7 SET DIE=9002313.93
+8 SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))
+9 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+10 SET CNT=CNT+1
+11 SET NAME=$PIECE(DATA,";",2)
+12 SET DR=".02////"_NAME
+13 DO ^DIE
End DoDot:1
+14 DO MES^XPDUTL(" - "_CNT_" entries updated")
+15 DO MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
+16 DO MES^XPDUTL(" ")
+17 QUIT
+18 ;
URJCT ; Updated reject explanation
+1 ;;650;DOS More Than 60 Days From CII Dt Rx Written for LTC/Terminally Ill Pt
+2 ;;
+3 ;
SCC ; Update Submission Clarification Code with new explanations
+1 NEW CNT,DA,DATA,DIE,DR,LINE,NAME,NUM
+2 DO MES^XPDUTL(" - Updating BPS NCPDP CLARIFICATION CODES")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(UPDSCC+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+5 SET NUM=$PIECE(DATA,";",1)
+6 SET DIE=9002313.25
+7 SET DA=$ORDER(^BPS(DIE,"B",NUM,""))
+8 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+9 SET CNT=CNT+1
+10 SET NAME=$PIECE(DATA,";",2)
+11 SET DR=".02////"_NAME
+12 DO ^DIE
End DoDot:1
+13 DO MES^XPDUTL(" - "_CNT_" entries updated")
+14 DO MES^XPDUTL(" - Done with BPS NCPDP CLARIFICATION CODES")
+15 DO MES^XPDUTL(" ")
+16 QUIT
+17 ;
UPDSCC ; Updated clarification code description
+1 ;;47;OTHER SHORTENED DAYS SUPPLY
+2 ;;
+3 ;
