BPSRES1 ;AITC/MRD - ECME SCREEN RESUBMIT W/EDITS ;10/23/17
;;1.0;E CLAIMS MGMT ENGINE;**23,24,32**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
ADDLFLDS(BPS02,BPS59,BPSADDLFLDS,BPSDOS) ; Add fields to a claim.
; This function allows the user to add to claim fields not on payer
; sheet. It is used by the RED/Resubmit with Edits Action on the
; ECME User Screen and by the PRO Option (Process Secondary/TRICARE
; Rx to ECME).
; Input: BPS02 = Pointer to BPS CLAIMS
; BPS59 = Pointer to BSP TRANSACTION
; BPSDOS = Date of Service; if passed in, then display
; when listing fields to be added to claim
; This function will return:
; 1 - If user entered additional fields.
; 0 - If user added no fields.
; -1 - If user exited out via "^".
; This function will also set up the array BPSADDFLDS if the user
; chooses to add any fields to the claim.
; BPSADDLFLDS(Field IEN) = Value to Send
;
N BPS,BPSFIELD,BPSGETCODE,BPSPAYER,BPSQ,BPSSEGMENT
N DIC,MEDN,TRANLIST,X,Y
;
; Prompt user whether to enter additional fields. If user enters
; "No", display the Date of Service, if it exists, then Quit with 0.
; If user enters "^", Quit with -1.
;
W !
S BPSQ=$$YESNO^BPSSCRRS("Submit NCPDP Field Not on Payer Sheet (Y/N)","N")
I BPSQ=0,$G(BPSDOS)'="" W !!,"Fields entered to transmit:",!,?4,"Date of Service: ",$$FMTE^XLFDT(BPSDOS,"5D")
I BPSQ'=1 Q BPSQ
;
; Kill array that will contain list of fields to be added.
;
K BPSADDLFLDS
;
; Build an array listing the fields already on the payer sheet and an
; array listing all segments on the payer sheet. Include all segments,
; though some may be excluded later.
;
D ARRAYS(BPS02,.BPSPAYER,.BPSSEGMENT)
I 'BPSPAYER Q 0
;
; Build BPS array. While each field in the file BPS NCPDP FIELD DEFS
; has Get Code (executable M code) for pulling the data value, the way
; this has been implemented is that first the subroutine $$BPS^BPSOSCB
; pulls many fields of data, building the BPS array, and then the
; Get Code for each field puts into BPS("X") a value from the BPS
; array. Because the system needs to display to the user the value
; that would be sent with a field being added to the claim, we need to
; build the entire BPS array, which will be used by the Get Code for
; any fields selected by the user. TRANLIST is an array listing all
; BPS Transactions in this batch of claims. However, the VA does not
; ever batch claims, so there is always only one transaction in that
; list. BPS(9002313.0201) must be set to 1. It should never return a
; value other than 0, but if it does, Quit.
;
S TRANLIST(BPS59)=""
S BPS(9002313.0201)=1
S X=$$BPS^BPSOSCB
I X W !,$P(X,U,2),".",!,"Fields may not be added at this time." Q 0
;
; Display help text.
;
W !!,"Enter a valid NCPDP Field name or number. Enter '??' for"
W !,"a list of possible choices. Fields already on the payer sheet"
W !,"are excluded from the list of possible choices. Also excluded"
W !,"are any fields that do not have logic to pull data from VistA"
W !,"(i.e. fields that will always be <blank>)."
;
A1 ; Prompt user for an NCPDP field to add to the claim.
;
K DIC
;
S DIC=9002313.91
S DIC(0)="AEMQ"
S DIC("A")="NCPDP Field Name or Number: "
S DIC("S")="I $$CHECK^BPSRES1(Y,.BPSPAYER,.BPSSEGMENT)"
S DIC("T")=""
;
W !
D ^DIC
;
; When the user just hits <return>, skip down to A2.
;
I X="" G A2
;
I Y=-1 Q -1
S BPSFIELD=+Y
;
; Disallow a field already added.
;
I $D(BPSADDLFLDS(BPSFIELD)) W !,?4,"This field has already been added to the claim.",*7 G A1
;
; Display to the user the value to be sent with this field.
;
S BPS("X")=""
S MEDN=1 ; Required for some GET codes.
S BPSGETCODE=0
F S BPSGETCODE=$O(^BPSF(9002313.91,BPSFIELD,10,BPSGETCODE)) Q:'BPSGETCODE X $G(^BPSF(9002313.91,BPSFIELD,10,BPSGETCODE,0))
W !,?4,"Value to transmit: ",BPS("X")
S BPSQ=$$YESNO^BPSSCRRS("Transmit with claim (Y/N)","Y")
I BPSQ=0 G A1
I BPSQ=-1 K BPSADDLFLDS Q -1
;
; Add selected field to array (Y=internal field #).
;
S BPSADDLFLDS(BPSFIELD)=BPS("X")
;
G A1
;
A2 ; User is done selecting fields to add.
;
; If user added no fields, Quit with 0.
;
I '$D(BPSADDLFLDS),'$G(BPSDOS) Q 0
;
; Display to the user the list of fields being added to the claim.
;
W !!,"Fields entered to transmit:"
I $G(BPSDOS)'="" W !,?4,"Date of Service: ",$$FMTE^XLFDT(BPSDOS,"5D")
S BPSFIELD=""
F S BPSFIELD=$O(BPSADDLFLDS(BPSFIELD)) Q:'BPSFIELD D
. W !,?4,$$GET1^DIQ(9002313.91,BPSFIELD,.01),"-"
. W $$GET1^DIQ(9002313.91,BPSFIELD,.06)," "
. W $$GET1^DIQ(9002313.91,BPSFIELD,.03),": "
. W BPSADDLFLDS(BPSFIELD)
. Q
;
Q 1
;
ARRAYS(BPS02,BPSPAYER,BPSSEGMENT) ; Build BPSPAYER array and BPSSEGMENT array.
;
; Build an array listing the fields already on the payer sheet and
; an array listing all segments on the payer sheet. Include all
; segments, though some may be excluded later.
;
N BPSFIELD,BPSORDER
;
S BPSPAYER=$$GET1^DIQ(9002313.02,BPS02,.02,"I") ; Payer Sheet.
I 'BPSPAYER Q
F BPSSEGMENT=100:10:300 D
. I '$D(^BPSF(9002313.92,BPSPAYER,BPSSEGMENT)) Q
. S BPSSEGMENT(BPSSEGMENT)=""
. S BPSORDER=0
. F S BPSORDER=$O(^BPSF(9002313.92,BPSPAYER,BPSSEGMENT,BPSORDER)) Q:'BPSORDER D
. . S BPSFIELD=$P($G(^BPSF(9002313.92,BPSPAYER,BPSSEGMENT,BPSORDER,0)),"^",2) ; Field IEN
. . I BPSFIELD'="" S BPSPAYER(BPSFIELD)=""
. . Q
. Q
;
Q
;
CHECK(BPSY,BPSPAYER,BPSSEGMENT) ; Screen for BPS NCPDP FIELD DEFS lookup. See ADDLFLDS above.
; This function is called for a given entry in the file BPS
; NCPDP FIELD DEFS, where +Y will be the IEN. If this function
; returns a 1, then this entry is a valid choice. If this
; function returns a 0, then this entry will not be displayed to
; the user when listing possible choices and this entry will not
; be a valid choice for the user.
;
; Disallow if already on the payer sheet.
;
I $D(BPSPAYER(+BPSY)) Q 0
;
; Disallow if this field is not on a request segment or if this
; field is on a segment not on the payer sheet.
;
S BPSSEGMENT=$P($G(^BPSF(9002313.91,+BPSY,5)),"^",4) ; Request Segment.
S BPSSEGMENT=$P($G(^BPSF(9002313.9,+BPSSEGMENT,0)),"^",2)
I BPSSEGMENT="" Q 0
I '$D(BPSSEGMENT(BPSSEGMENT)) Q 0
;
; There are many segments the VA does not send, even if that
; segment is on a payer sheet. Disallow any fields that are
; on one of those segments.
;
I ",140,170,200,210,220,230,240,250,260,270,280,290,300,"[(","_BPSSEGMENT_",") Q 0
;
; Disallow if Get Code is simply Setting BPS("X") to "".
;
I $G(^BPSF(9002313.91,+BPSY,10,1,0))["S BPS(""X"")=""""" Q 0
;
Q 1
;
SAVE(BPSACTION,BPS59,BPSADDLFLDS,BPSOVRIEN) ; Save into BPS NCPDP OVERRIDES (#9002313.511)
;
; If the user chooses to add any fields to the claim, each field
; will be listed as BPSADDLFLDS(Field IEN).
;
; Input: BPSACTION = Action selected by user (e.g. RED, PRO)
; BPS59 = Pointer to BPS TRANSACTIONS
; BPSADDLFLDS = Passed by reference, array listing the
; NCPDP fields to be added to the claim.
; BPSADDLFLDS(NCPDP Field) = ""
; BPSOVRIEN = Passed by reference, ien of entry in the
; file BPS NCPDP OVERRIDE
;
N BPSFDA,BPSFIELD,BPSMSG,BPSCNT,BPSFIELD
;
S BPSFDA(9002313.511,"+1,",.01)=BPS59
D NOW^%DTC
S BPSFDA(9002313.511,"+1,",.02)=%
;
; Store the fields for which the user was prompted.
;
S BPSCNT=1
I BPSACTION="RED" D
. S BPSFIELD=$O(^BPSF(9002313.91,"B",303,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+2,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+2,+1,",.02)=BPPSNCD
. S BPSFIELD=$O(^BPSF(9002313.91,"B",306,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+3,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+3,+1,",.02)=BPRELCD
. S BPSFIELD=$O(^BPSF(9002313.91,"B",462,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+4,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+4,+1,",.02)=BPPREAUT
. S BPSFIELD=$O(^BPSF(9002313.91,"B",461,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+5,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+5,+1,",.02)=BPPRETYP
. S BPSFIELD=$O(^BPSF(9002313.91,"B",420,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+6,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+6,+1,",.02)=BPCLCD1_"~"_$G(BPCLCD2)_"~"_$G(BPCLCD3)
. S BPSFIELD=$O(^BPSF(9002313.91,"B",384,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+7,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+7,+1,",.02)=BPPTRES
. S BPSFIELD=$O(^BPSF(9002313.91,"B",147,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+8,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+8,+1,",.02)=BPPHSRV
. S BPSFIELD=$O(^BPSF(9002313.91,"B",357,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+9,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+9,+1,",.02)=BPDLYRS
. S BPSFIELD=$O(^BPSF(9002313.91,"B",305,"")) I BPSFIELD]"" S BPSFDA(9002313.5111,"+10,+1,",.01)=BPSFIELD,BPSFDA(9002313.5111,"+10,+1,",.02)=BPGENDER
. S BPSCNT=10
. Q
;
; Store additional NCPDP fields which the user chose to add to the
; the resubmitted claim.
;
S BPSFIELD=0
F S BPSFIELD=$O(BPSADDLFLDS(BPSFIELD)) Q:'BPSFIELD D
. S BPSCNT=BPSCNT+1
. S BPSFDA(9002313.5112,"+"_BPSCNT_",+1,",.01)=BPSFIELD ; Field#
. S BPSFDA(9002313.5112,"+"_BPSCNT_",+1,",.02)=$$GET1^DIQ(9002313.91,BPSFIELD,2,"I") ; Segment#
. Q
;
D UPDATE^DIE("","BPSFDA","BPSOVRIEN","BPSMSG")
;
I $D(BPSMSG("DIERR")) D Q -1
. W !!,"Could not save override information into BPS NCPDP OVERRIDE file.",!
. N DIR
. S DIR(0)="E"
. S DIR("A")="Press Return to continue."
. D ^DIR
. Q
;
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRES1 9719 printed Dec 13, 2024@01:52:33 Page 2
BPSRES1 ;AITC/MRD - ECME SCREEN RESUBMIT W/EDITS ;10/23/17
+1 ;;1.0;E CLAIMS MGMT ENGINE;**23,24,32**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
ADDLFLDS(BPS02,BPS59,BPSADDLFLDS,BPSDOS) ; Add fields to a claim.
+1 ; This function allows the user to add to claim fields not on payer
+2 ; sheet. It is used by the RED/Resubmit with Edits Action on the
+3 ; ECME User Screen and by the PRO Option (Process Secondary/TRICARE
+4 ; Rx to ECME).
+5 ; Input: BPS02 = Pointer to BPS CLAIMS
+6 ; BPS59 = Pointer to BSP TRANSACTION
+7 ; BPSDOS = Date of Service; if passed in, then display
+8 ; when listing fields to be added to claim
+9 ; This function will return:
+10 ; 1 - If user entered additional fields.
+11 ; 0 - If user added no fields.
+12 ; -1 - If user exited out via "^".
+13 ; This function will also set up the array BPSADDFLDS if the user
+14 ; chooses to add any fields to the claim.
+15 ; BPSADDLFLDS(Field IEN) = Value to Send
+16 ;
+17 NEW BPS,BPSFIELD,BPSGETCODE,BPSPAYER,BPSQ,BPSSEGMENT
+18 NEW DIC,MEDN,TRANLIST,X,Y
+19 ;
+20 ; Prompt user whether to enter additional fields. If user enters
+21 ; "No", display the Date of Service, if it exists, then Quit with 0.
+22 ; If user enters "^", Quit with -1.
+23 ;
+24 WRITE !
+25 SET BPSQ=$$YESNO^BPSSCRRS("Submit NCPDP Field Not on Payer Sheet (Y/N)","N")
+26 IF BPSQ=0
IF $GET(BPSDOS)'=""
WRITE !!,"Fields entered to transmit:",!,?4,"Date of Service: ",$$FMTE^XLFDT(BPSDOS,"5D")
+27 IF BPSQ'=1
QUIT BPSQ
+28 ;
+29 ; Kill array that will contain list of fields to be added.
+30 ;
+31 KILL BPSADDLFLDS
+32 ;
+33 ; Build an array listing the fields already on the payer sheet and an
+34 ; array listing all segments on the payer sheet. Include all segments,
+35 ; though some may be excluded later.
+36 ;
+37 DO ARRAYS(BPS02,.BPSPAYER,.BPSSEGMENT)
+38 IF 'BPSPAYER
QUIT 0
+39 ;
+40 ; Build BPS array. While each field in the file BPS NCPDP FIELD DEFS
+41 ; has Get Code (executable M code) for pulling the data value, the way
+42 ; this has been implemented is that first the subroutine $$BPS^BPSOSCB
+43 ; pulls many fields of data, building the BPS array, and then the
+44 ; Get Code for each field puts into BPS("X") a value from the BPS
+45 ; array. Because the system needs to display to the user the value
+46 ; that would be sent with a field being added to the claim, we need to
+47 ; build the entire BPS array, which will be used by the Get Code for
+48 ; any fields selected by the user. TRANLIST is an array listing all
+49 ; BPS Transactions in this batch of claims. However, the VA does not
+50 ; ever batch claims, so there is always only one transaction in that
+51 ; list. BPS(9002313.0201) must be set to 1. It should never return a
+52 ; value other than 0, but if it does, Quit.
+53 ;
+54 SET TRANLIST(BPS59)=""
+55 SET BPS(9002313.0201)=1
+56 SET X=$$BPS^BPSOSCB
+57 IF X
WRITE !,$PIECE(X,U,2),".",!,"Fields may not be added at this time."
QUIT 0
+58 ;
+59 ; Display help text.
+60 ;
+61 WRITE !!,"Enter a valid NCPDP Field name or number. Enter '??' for"
+62 WRITE !,"a list of possible choices. Fields already on the payer sheet"
+63 WRITE !,"are excluded from the list of possible choices. Also excluded"
+64 WRITE !,"are any fields that do not have logic to pull data from VistA"
+65 WRITE !,"(i.e. fields that will always be <blank>)."
+66 ;
A1 ; Prompt user for an NCPDP field to add to the claim.
+1 ;
+2 KILL DIC
+3 ;
+4 SET DIC=9002313.91
+5 SET DIC(0)="AEMQ"
+6 SET DIC("A")="NCPDP Field Name or Number: "
+7 SET DIC("S")="I $$CHECK^BPSRES1(Y,.BPSPAYER,.BPSSEGMENT)"
+8 SET DIC("T")=""
+9 ;
+10 WRITE !
+11 DO ^DIC
+12 ;
+13 ; When the user just hits <return>, skip down to A2.
+14 ;
+15 IF X=""
GOTO A2
+16 ;
+17 IF Y=-1
QUIT -1
+18 SET BPSFIELD=+Y
+19 ;
+20 ; Disallow a field already added.
+21 ;
+22 IF $DATA(BPSADDLFLDS(BPSFIELD))
WRITE !,?4,"This field has already been added to the claim.",*7
GOTO A1
+23 ;
+24 ; Display to the user the value to be sent with this field.
+25 ;
+26 SET BPS("X")=""
+27 ; Required for some GET codes.
SET MEDN=1
+28 SET BPSGETCODE=0
+29 FOR
SET BPSGETCODE=$ORDER(^BPSF(9002313.91,BPSFIELD,10,BPSGETCODE))
if 'BPSGETCODE
QUIT
XECUTE $GET(^BPSF(9002313.91,BPSFIELD,10,BPSGETCODE,0))
+30 WRITE !,?4,"Value to transmit: ",BPS("X")
+31 SET BPSQ=$$YESNO^BPSSCRRS("Transmit with claim (Y/N)","Y")
+32 IF BPSQ=0
GOTO A1
+33 IF BPSQ=-1
KILL BPSADDLFLDS
QUIT -1
+34 ;
+35 ; Add selected field to array (Y=internal field #).
+36 ;
+37 SET BPSADDLFLDS(BPSFIELD)=BPS("X")
+38 ;
+39 GOTO A1
+40 ;
A2 ; User is done selecting fields to add.
+1 ;
+2 ; If user added no fields, Quit with 0.
+3 ;
+4 IF '$DATA(BPSADDLFLDS)
IF '$GET(BPSDOS)
QUIT 0
+5 ;
+6 ; Display to the user the list of fields being added to the claim.
+7 ;
+8 WRITE !!,"Fields entered to transmit:"
+9 IF $GET(BPSDOS)'=""
WRITE !,?4,"Date of Service: ",$$FMTE^XLFDT(BPSDOS,"5D")
+10 SET BPSFIELD=""
+11 FOR
SET BPSFIELD=$ORDER(BPSADDLFLDS(BPSFIELD))
if 'BPSFIELD
QUIT
Begin DoDot:1
+12 WRITE !,?4,$$GET1^DIQ(9002313.91,BPSFIELD,.01),"-"
+13 WRITE $$GET1^DIQ(9002313.91,BPSFIELD,.06)," "
+14 WRITE $$GET1^DIQ(9002313.91,BPSFIELD,.03),": "
+15 WRITE BPSADDLFLDS(BPSFIELD)
+16 QUIT
End DoDot:1
+17 ;
+18 QUIT 1
+19 ;
ARRAYS(BPS02,BPSPAYER,BPSSEGMENT) ; Build BPSPAYER array and BPSSEGMENT array.
+1 ;
+2 ; Build an array listing the fields already on the payer sheet and
+3 ; an array listing all segments on the payer sheet. Include all
+4 ; segments, though some may be excluded later.
+5 ;
+6 NEW BPSFIELD,BPSORDER
+7 ;
+8 ; Payer Sheet.
SET BPSPAYER=$$GET1^DIQ(9002313.02,BPS02,.02,"I")
+9 IF 'BPSPAYER
QUIT
+10 FOR BPSSEGMENT=100:10:300
Begin DoDot:1
+11 IF '$DATA(^BPSF(9002313.92,BPSPAYER,BPSSEGMENT))
QUIT
+12 SET BPSSEGMENT(BPSSEGMENT)=""
+13 SET BPSORDER=0
+14 FOR
SET BPSORDER=$ORDER(^BPSF(9002313.92,BPSPAYER,BPSSEGMENT,BPSORDER))
if 'BPSORDER
QUIT
Begin DoDot:2
+15 ; Field IEN
SET BPSFIELD=$PIECE($GET(^BPSF(9002313.92,BPSPAYER,BPSSEGMENT,BPSORDER,0)),"^",2)
+16 IF BPSFIELD'=""
SET BPSPAYER(BPSFIELD)=""
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 ;
+20 QUIT
+21 ;
CHECK(BPSY,BPSPAYER,BPSSEGMENT) ; Screen for BPS NCPDP FIELD DEFS lookup. See ADDLFLDS above.
+1 ; This function is called for a given entry in the file BPS
+2 ; NCPDP FIELD DEFS, where +Y will be the IEN. If this function
+3 ; returns a 1, then this entry is a valid choice. If this
+4 ; function returns a 0, then this entry will not be displayed to
+5 ; the user when listing possible choices and this entry will not
+6 ; be a valid choice for the user.
+7 ;
+8 ; Disallow if already on the payer sheet.
+9 ;
+10 IF $DATA(BPSPAYER(+BPSY))
QUIT 0
+11 ;
+12 ; Disallow if this field is not on a request segment or if this
+13 ; field is on a segment not on the payer sheet.
+14 ;
+15 ; Request Segment.
SET BPSSEGMENT=$PIECE($GET(^BPSF(9002313.91,+BPSY,5)),"^",4)
+16 SET BPSSEGMENT=$PIECE($GET(^BPSF(9002313.9,+BPSSEGMENT,0)),"^",2)
+17 IF BPSSEGMENT=""
QUIT 0
+18 IF '$DATA(BPSSEGMENT(BPSSEGMENT))
QUIT 0
+19 ;
+20 ; There are many segments the VA does not send, even if that
+21 ; segment is on a payer sheet. Disallow any fields that are
+22 ; on one of those segments.
+23 ;
+24 IF ",140,170,200,210,220,230,240,250,260,270,280,290,300,"[(","_BPSSEGMENT_",")
QUIT 0
+25 ;
+26 ; Disallow if Get Code is simply Setting BPS("X") to "".
+27 ;
+28 IF $GET(^BPSF(9002313.91,+BPSY,10,1,0))["S BPS(""X"")="""""
QUIT 0
+29 ;
+30 QUIT 1
+31 ;
SAVE(BPSACTION,BPS59,BPSADDLFLDS,BPSOVRIEN) ; Save into BPS NCPDP OVERRIDES (#9002313.511)
+1 ;
+2 ; If the user chooses to add any fields to the claim, each field
+3 ; will be listed as BPSADDLFLDS(Field IEN).
+4 ;
+5 ; Input: BPSACTION = Action selected by user (e.g. RED, PRO)
+6 ; BPS59 = Pointer to BPS TRANSACTIONS
+7 ; BPSADDLFLDS = Passed by reference, array listing the
+8 ; NCPDP fields to be added to the claim.
+9 ; BPSADDLFLDS(NCPDP Field) = ""
+10 ; BPSOVRIEN = Passed by reference, ien of entry in the
+11 ; file BPS NCPDP OVERRIDE
+12 ;
+13 NEW BPSFDA,BPSFIELD,BPSMSG,BPSCNT,BPSFIELD
+14 ;
+15 SET BPSFDA(9002313.511,"+1,",.01)=BPS59
+16 DO NOW^%DTC
+17 SET BPSFDA(9002313.511,"+1,",.02)=%
+18 ;
+19 ; Store the fields for which the user was prompted.
+20 ;
+21 SET BPSCNT=1
+22 IF BPSACTION="RED"
Begin DoDot:1
+23 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",303,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+2,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+2,+1,",.02)=BPPSNCD
+24 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",306,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+3,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+3,+1,",.02)=BPRELCD
+25 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",462,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+4,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+4,+1,",.02)=BPPREAUT
+26 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",461,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+5,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+5,+1,",.02)=BPPRETYP
+27 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",420,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+6,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+6,+1,",.02)=BPCLCD1_"~"_$GET(BPCLCD2)_"~"_$GET(BPCLCD3)
+28 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",384,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+7,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+7,+1,",.02)=BPPTRES
+29 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",147,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+8,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+8,+1,",.02)=BPPHSRV
+30 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",357,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+9,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+9,+1,",.02)=BPDLYRS
+31 SET BPSFIELD=$ORDER(^BPSF(9002313.91,"B",305,""))
IF BPSFIELD]""
SET BPSFDA(9002313.5111,"+10,+1,",.01)=BPSFIELD
SET BPSFDA(9002313.5111,"+10,+1,",.02)=BPGENDER
+32 SET BPSCNT=10
+33 QUIT
End DoDot:1
+34 ;
+35 ; Store additional NCPDP fields which the user chose to add to the
+36 ; the resubmitted claim.
+37 ;
+38 SET BPSFIELD=0
+39 FOR
SET BPSFIELD=$ORDER(BPSADDLFLDS(BPSFIELD))
if 'BPSFIELD
QUIT
Begin DoDot:1
+40 SET BPSCNT=BPSCNT+1
+41 ; Field#
SET BPSFDA(9002313.5112,"+"_BPSCNT_",+1,",.01)=BPSFIELD
+42 ; Segment#
SET BPSFDA(9002313.5112,"+"_BPSCNT_",+1,",.02)=$$GET1^DIQ(9002313.91,BPSFIELD,2,"I")
+43 QUIT
End DoDot:1
+44 ;
+45 DO UPDATE^DIE("","BPSFDA","BPSOVRIEN","BPSMSG")
+46 ;
+47 IF $DATA(BPSMSG("DIERR"))
Begin DoDot:1
+48 WRITE !!,"Could not save override information into BPS NCPDP OVERRIDE file.",!
+49 NEW DIR
+50 SET DIR(0)="E"
+51 SET DIR("A")="Press Return to continue."
+52 DO ^DIR
+53 QUIT
End DoDot:1
QUIT -1
+54 ;
+55 QUIT 1
+56 ;
