BPSOSRX2 ;ALB/SS - ECME REQUESTS ;30-NOV-07
;;1.0;E CLAIMS MGMT ENGINE;**7,8,10,11**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;Store insurer data in BPS INSURER DATA file
; KEY1 - First Key of the Request file
; KEY2 - Second Key of the Request file
; MOREDATA - Array of data needed for transaction/claim
; BPCOBIND - "active" COB indicator (the one is processed currently) COB
; BPIEN77 - BPS REQUEST ien (request for which the BPS INSURER DATA record is created)
;
;
INSURER(KEY1,KEY2,MOREDATA,BPCOBIND) ;
N BPIEN78,BPIEN59,REL,PERCD
;IBDATA
;Create a new record with .01 field only
S BPIEN59=$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND)
S BPIEN78=+$$INSITEM^BPSUTIL2(9002313.78,"",BPIEN59,"","") ;BPS Transaction IEN
I BPIEN78<1 Q "0^Cannot create a record in BPS INSURER DATA"
;
; Check for proper payer sheets
I $G(MOREDATA("RX ACTION"))'="ELIG",$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,16)="" Q "0^Billing payer sheet is missing"
I $G(MOREDATA("RX ACTION"))'="ELIG",$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,17)="" Q "0^Reversal payer sheet is missing"
I $G(MOREDATA("RX ACTION"))="ELIG",$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,19)="" Q "0^Eligibility payer sheet is missing"
;
; Populate remaining fields
I $$FILLFLDS^BPSUTIL2(9002313.78,".02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,16)) ; Billing Payer Sheet IEN
I $$FILLFLDS^BPSUTIL2(9002313.78,".03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,17)) ; Reversal Payer Sheet IEN
I $$FILLFLDS^BPSUTIL2(9002313.78,".04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,18)) ; Rebill Payer Sheet IEN
I $$FILLFLDS^BPSUTIL2(9002313.78,".07",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,14))
I $$FILLFLDS^BPSUTIL2(9002313.78,".08",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,1))
I $$FILLFLDS^BPSUTIL2(9002313.78,".09",BPIEN78,BPCOBIND)
I $$FILLFLDS^BPSUTIL2(9002313.78,".1",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,19)) ; Eligibility Payer Sheet IEN
I $$FILLFLDS^BPSUTIL2(9002313.78,".11",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,7))
;
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,2))
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,3))
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,5))
I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,6)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"1.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,6))
S REL=$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,7)
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.05",BPIEN78,$S(REL>4:4,1:+REL))
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.06",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,8))
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.07",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,9))
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.08",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,10))
S PERCD=$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,20)
I PERCD="" S PERCD=$S(REL=1:"01",REL=2:"02",REL=3:"03",1:"")
I $$FILLFLDS^BPSUTIL2(9002313.78,"1.09",BPIEN78,PERCD)
;
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,1))
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,2))
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,7))
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,4))
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.05",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,5))
I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,13)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"2.06",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,13))
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.07",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,8))
I $$FILLFLDS^BPSUTIL2(9002313.78,"2.08",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,6))
;
I $$FILLFLDS^BPSUTIL2(9002313.78,"3.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,1))
I $P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,2)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"3.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,2))
I $$FILLFLDS^BPSUTIL2(9002313.78,"3.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,3))
I $$FILLFLDS^BPSUTIL2(9002313.78,"3.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,4))
I $$FILLFLDS^BPSUTIL2(9002313.78,"3.05",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,5))
I $$FILLFLDS^BPSUTIL2(9002313.78,"3.06",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,6))
;
I $$FILLFLDS^BPSUTIL2(9002313.78,"4.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,4)) ; Billing Payer Sheet Name
I $$FILLFLDS^BPSUTIL2(9002313.78,"4.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,11)) ; Reversal Payer Sheet Name
I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,12)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"4.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,12)) ; Rebill Payer Sheet Name
I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,15)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"4.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,15)) ; Eligibility Payer Sheet Name
;
I $$FILLFLDS^BPSUTIL2(9002313.78,"5.01",BPIEN78,+DUZ)
I $$FILLFLDS^BPSUTIL2(9002313.78,"5.02",BPIEN78,DT)
;
Q "1^"_BPIEN78
;
ERRFIELD(BP78,BPFIELD) ;
N DIK,DA
S DIK="^BPS(9002313.78,"
S DA=BP78
D ^DIK ;delete incomplete record
;return the error message
Q $$FIELDMSG(0,"",9002313.78,$G(BPFIELD))
;
;Store MOREDATA("IBDATA") in BPS INSURER DATA file
; KEY1 - First key of the BPS Request File
; KEY2 - Second Key of the BPS Request File
; MOREDATA - Array of data needed for transaction/claim
; BPINSUR(COB,IEN78) = array to return back BPS INSURERE DATA iens created
; return value:
; 1 = success
; 0^message = if one of the records wasn't created
MKINSUR(KEY1,KEY2,MOREDATA,BPINSUR) ;
N BPQ,BPCOB,BPERRMSG
S BPERRMSG=""
S BPQ=0,BPCOB=0
F S BPCOB=$O(MOREDATA("IBDATA",BPCOB)) Q:+BPCOB=0!(BPQ=1) D
. S BPIEN78=$$INSURER(KEY1,KEY2,.MOREDATA,BPCOB)
. I BPIEN78<1 S BPERRMSG="Missing data for the file #9002313.78, "_$P(BPIEN78,U,2),BPQ=1 Q
. S BPINSUR(BPCOB)=+$P(BPIEN78,U,2)
I BPQ=1 Q "0^"_BPERRMSG
Q 1
;add field name to the message
;BPRFILE - if 1 then add file # to the message
;BPMESS,BPFILENO,BPFLDNO - message text, file # and field #
FIELDMSG(BPRFILE,BPMESS,BPFILENO,BPFLDNO) ;
N BPFLDNM
I ('$G(BPFILENO))!('$G(BPFLDNO)) Q $G(BPMESS)
D FIELD^DID(BPFILENO,BPFLDNO,"","LABEL","BPFLDNM")
Q $G(BPMESS)_$S($G(BPRFILE)=1:"file #"_BPFILENO_",",1:"")_"field #"_BPFLDNO_" ("_$G(BPFLDNM("LABEL"))_")"
;BPSOSRX2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSRX2 6601 printed Dec 13, 2024@01:52 Page 2
BPSOSRX2 ;ALB/SS - ECME REQUESTS ;30-NOV-07
+1 ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10,11**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;Store insurer data in BPS INSURER DATA file
+5 ; KEY1 - First Key of the Request file
+6 ; KEY2 - Second Key of the Request file
+7 ; MOREDATA - Array of data needed for transaction/claim
+8 ; BPCOBIND - "active" COB indicator (the one is processed currently) COB
+9 ; BPIEN77 - BPS REQUEST ien (request for which the BPS INSURER DATA record is created)
+10 ;
+11 ;
INSURER(KEY1,KEY2,MOREDATA,BPCOBIND) ;
+1 NEW BPIEN78,BPIEN59,REL,PERCD
+2 ;IBDATA
+3 ;Create a new record with .01 field only
+4 SET BPIEN59=$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND)
+5 ;BPS Transaction IEN
SET BPIEN78=+$$INSITEM^BPSUTIL2(9002313.78,"",BPIEN59,"","")
+6 IF BPIEN78<1
QUIT "0^Cannot create a record in BPS INSURER DATA"
+7 ;
+8 ; Check for proper payer sheets
+9 IF $GET(MOREDATA("RX ACTION"))'="ELIG"
IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,16)=""
QUIT "0^Billing payer sheet is missing"
+10 IF $GET(MOREDATA("RX ACTION"))'="ELIG"
IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,17)=""
QUIT "0^Reversal payer sheet is missing"
+11 IF $GET(MOREDATA("RX ACTION"))="ELIG"
IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,19)=""
QUIT "0^Eligibility payer sheet is missing"
+12 ;
+13 ; Populate remaining fields
+14 ; Billing Payer Sheet IEN
IF $$FILLFLDS^BPSUTIL2(9002313.78,".02",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,16))
+15 ; Reversal Payer Sheet IEN
IF $$FILLFLDS^BPSUTIL2(9002313.78,".03",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,17))
+16 ; Rebill Payer Sheet IEN
IF $$FILLFLDS^BPSUTIL2(9002313.78,".04",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,18))
+17 IF $$FILLFLDS^BPSUTIL2(9002313.78,".07",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,14))
+18 IF $$FILLFLDS^BPSUTIL2(9002313.78,".08",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,1))
+19 IF $$FILLFLDS^BPSUTIL2(9002313.78,".09",BPIEN78,BPCOBIND)
+20 ; Eligibility Payer Sheet IEN
IF $$FILLFLDS^BPSUTIL2(9002313.78,".1",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,19))
+21 IF $$FILLFLDS^BPSUTIL2(9002313.78,".11",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,7))
+22 ;
+23 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.01",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,2))
+24 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.02",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,3))
+25 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.03",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,5))
+26 IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,6)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.04",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,6))
+27 SET REL=$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,7)
+28 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.05",BPIEN78,$SELECT(REL>4:4,1:+REL))
+29 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.06",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,8))
+30 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.07",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,9))
+31 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.08",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,10))
+32 SET PERCD=$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,20)
+33 IF PERCD=""
SET PERCD=$SELECT(REL=1:"01",REL=2:"02",REL=3:"03",1:"")
+34 IF $$FILLFLDS^BPSUTIL2(9002313.78,"1.09",BPIEN78,PERCD)
+35 ;
+36 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.01",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,2)),U,1))
+37 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.02",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,2)),U,2))
+38 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.03",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,2)),U,7))
+39 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.04",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,2)),U,4))
+40 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.05",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,2)),U,5))
+41 IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,13)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.06",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,13))
+42 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.07",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,8))
+43 IF $$FILLFLDS^BPSUTIL2(9002313.78,"2.08",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,2)),U,6))
+44 ;
+45 IF $$FILLFLDS^BPSUTIL2(9002313.78,"3.01",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,1))
+46 IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,2)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.78,"3.02",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,2))
+47 IF $$FILLFLDS^BPSUTIL2(9002313.78,"3.03",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,3))
+48 IF $$FILLFLDS^BPSUTIL2(9002313.78,"3.04",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,4))
+49 IF $$FILLFLDS^BPSUTIL2(9002313.78,"3.05",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,5))
+50 IF $$FILLFLDS^BPSUTIL2(9002313.78,"3.06",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,3)),U,6))
+51 ;
+52 ; Billing Payer Sheet Name
IF $$FILLFLDS^BPSUTIL2(9002313.78,"4.01",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,4))
+53 ; Reversal Payer Sheet Name
IF $$FILLFLDS^BPSUTIL2(9002313.78,"4.02",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,11))
+54 ; Rebill Payer Sheet Name
IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,12)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.78,"4.03",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,12))
+55 ; Eligibility Payer Sheet Name
IF $PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,15)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.78,"4.04",BPIEN78,$PIECE($GET(MOREDATA("IBDATA",BPCOBIND,1)),U,15))
+56 ;
+57 IF $$FILLFLDS^BPSUTIL2(9002313.78,"5.01",BPIEN78,+DUZ)
+58 IF $$FILLFLDS^BPSUTIL2(9002313.78,"5.02",BPIEN78,DT)
+59 ;
+60 QUIT "1^"_BPIEN78
+61 ;
ERRFIELD(BP78,BPFIELD) ;
+1 NEW DIK,DA
+2 SET DIK="^BPS(9002313.78,"
+3 SET DA=BP78
+4 ;delete incomplete record
DO ^DIK
+5 ;return the error message
+6 QUIT $$FIELDMSG(0,"",9002313.78,$GET(BPFIELD))
+7 ;
+8 ;Store MOREDATA("IBDATA") in BPS INSURER DATA file
+9 ; KEY1 - First key of the BPS Request File
+10 ; KEY2 - Second Key of the BPS Request File
+11 ; MOREDATA - Array of data needed for transaction/claim
+12 ; BPINSUR(COB,IEN78) = array to return back BPS INSURERE DATA iens created
+13 ; return value:
+14 ; 1 = success
+15 ; 0^message = if one of the records wasn't created
MKINSUR(KEY1,KEY2,MOREDATA,BPINSUR) ;
+1 NEW BPQ,BPCOB,BPERRMSG
+2 SET BPERRMSG=""
+3 SET BPQ=0
SET BPCOB=0
+4 FOR
SET BPCOB=$ORDER(MOREDATA("IBDATA",BPCOB))
if +BPCOB=0!(BPQ=1)
QUIT
Begin DoDot:1
+5 SET BPIEN78=$$INSURER(KEY1,KEY2,.MOREDATA,BPCOB)
+6 IF BPIEN78<1
SET BPERRMSG="Missing data for the file #9002313.78, "_$PIECE(BPIEN78,U,2)
SET BPQ=1
QUIT
+7 SET BPINSUR(BPCOB)=+$PIECE(BPIEN78,U,2)
End DoDot:1
+8 IF BPQ=1
QUIT "0^"_BPERRMSG
+9 QUIT 1
+10 ;add field name to the message
+11 ;BPRFILE - if 1 then add file # to the message
+12 ;BPMESS,BPFILENO,BPFLDNO - message text, file # and field #
FIELDMSG(BPRFILE,BPMESS,BPFILENO,BPFLDNO) ;
+1 NEW BPFLDNM
+2 IF ('$GET(BPFILENO))!('$GET(BPFLDNO))
QUIT $GET(BPMESS)
+3 DO FIELD^DID(BPFILENO,BPFLDNO,"","LABEL","BPFLDNM")
+4 QUIT $GET(BPMESS)_$SELECT($GET(BPRFILE)=1:"file #"_BPFILENO_",",1:"")_"field #"_BPFLDNO_" ("_$GET(BPFLDNM("LABEL"))_")"
+5 ;BPSOSRX2
