BPSECX0 ;BHAM ISC/FCS/DRS/VA/DLF - Retrieve Claim submission record ;05/17/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,15,19,23,24,27**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
; This routine is used to pull data from BPS Claims and its multiples
; GETBPS2 - BPS Claims level
; GETBPS3 - Transaction subfile
; GETBPS4 - DUR subfile
; GETBPS5 - COB subfile. GETBPS5 calls the following
; GETBPS6 - Other Payer Amount Paid subfile
; GETBPS7 - Other Payer Reject Code subfile
; GETBPS8 - Other Payer Patient Responsibility subfile
; GETBPS9 - Benefits Stage subfile
;
Q
;
; Retrieve BPS CLAIMS data
; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
; BPS - Passed by reference
; returns: BPS(9002313.02,CLAIMIEN,field #,"I") = internal format value
GETBPS2(CLAIMIEN,BPS) ; called from BPSECA1 > BPSOSQG > BPSOSQ2
;
Q:$G(CLAIMIEN)="" ; must have claim IEN
;
N D0,DA,DIC,DIQ,DIQ2,DR
;
S DIC=9002313.02,DR="101:899;980:997" ; all fields from 101-899 and 990-997, skip 901-908 (used for BPS overhead)
S DR=DR_";1022;1043;1045" ;Get alphanumeric NCPDP fields 1022 (A22), 1043 (A23) and 1045 (A45)- BPS*1*15
S DR=DR_";2008;2009;2038" ;Get alphanumeric NCPDP fields 2008 (B08), 2009 (B09) and 2038 (B38) - BPS*1*19
S DR=DR_";2306;2309:2311" ;Get alphanumeric NCPDP fields 2306 (E06), 2309 (E09), 2310 (E10) and 2311 (E11) - BPS*1*27
S DA=CLAIMIEN,DIQ="BPS",DIQ(0)="I" ; "I" for internal format
D EN^DIQ1
Q
;
;Retrieve data in TRANSACTIONS multiple in BPS CLAIMS
; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
; TRXIEN = ien in TRANSACTIONS (#9002313.0201)
; BPS - Passed by reference
; returns: BPS(9002313.0201,TRXIEN,field #,"I") = internal format value
GETBPS3(CLAIMIEN,TRXIEN,BPS) ;called from BPSECA1
;
Q:$G(CLAIMIEN)="" Q:$G(TRXIEN)="" ; must have both
;
N D0,DA,DIC,DIQ,DIQ2,DR
;
; There are other alphanumeric fields that could be added but since they are for segments that are not
; supported by E1, B1, B3 transactions and/or not segments not used by VA. These can be added later, if
; needed for those segments.
S DIC=9002313.02,DR="400",DR(9002313.0201)="113:996" ; all TRANSACTION fields
S DR(9002313.0201)=DR(9002313.0201)_";1023:1032"
S DR(9002313.0201)=DR(9002313.0201)_";2024:2032;2039:2043"
S DR(9002313.0201)=DR(9002313.0201)_";1093;2013:2021;2034;2035;2037"
S DR(9002313.0201)=DR(9002313.0201)_";2056:2061;2095:2097;2101;2102"
; new fields added in 2017 NCPDP updates
S DR(9002313.0201)=DR(9002313.0201)_";2147;2149;2150;2151;2160;2190;2191"
S DR(9002313.0201)=DR(9002313.0201)_";2192;2198;2199;2201;2202;2214;2216"
S DR(9002313.0201)=DR(9002313.0201)_";2217;2218;2221;2222;2251;2252;2253"
S DR(9002313.0201)=DR(9002313.0201)_";2257;2260;2261;2263;2312"
;
S DA=CLAIMIEN,DA(9002313.0201)=TRXIEN ; IEN and sub-file IEN
S DIQ="BPS",DIQ(0)="I" ; "I" for internal format
D EN^DIQ1
;
; Copy Prescriber Phone Number (498.12) to field 498 as this is where BPSOSH2
; expects to find it. This works for now but if we implement the Prior Auth
; segment (which has multiple field labelled 498), a more complete solution
; will need to be found
S BPS(9002313.0201,TRXIEN,498,"I")=$G(BPS(9002313.0201,TRXIEN,498.12,"I"))
Q
;
;Retrieve DUR/PPS multiple data
; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
; TRXIEN = ien in TRANSACTIONS (#9002313.0201)
; CDURIEN= DUR/PPS Multiple IEN (9002313.1001)
; BPS - Passed by reference
; returns: BPS(9002313.1001,CDURIEN,field #,"I") = Value
GETBPS4(CLAIMIEN,TRXIEN,CDURIEN,BPS) ;EP - from BPSECA1
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(TRXIEN)=""
Q:$G(CDURIEN)=""
;
N D0,DA,DIC,DIQ,DIQ2,DR
S DIC=9002313.02
S DR="400",DR(9002313.0201)=473.01 ;fields
S DR(9002313.1001)=".01;439;440;441;474;475;476" ;fields
S DA=CLAIMIEN,DA(9002313.0201)=TRXIEN,DA(9002313.1001)=CDURIEN
S DIQ="BPS",DIQ(0)="I"
D EN^DIQ1
;
Q
;
;Retrieve COB OTHER PAYMENTS multiple data
; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
; TRXIEN = ien in TRANSACTIONS (#9002313.0201)
; BPCOBIEN= ien in COB OTHER PAYMENTS (#9002313.0401)
; BPS - Passed by reference
; Output: BPS(9002313.0401,BPCOBIEN,field #,"I") = Value
GETBPS5(CLAIMIEN,TRXIEN,BPCOBIEN,BPS) ;EP - from BPSECA1
;
Q:$G(CLAIMIEN)="" Q:$G(TRXIEN)="" Q:$G(BPCOBIEN)=""
;
N BPREJCT,BPSCNT,BPSPAMT,BPSOTHR,D0,DA,DIC,DIQ,DIQ2,DR
;
S DIC=9002313.02
S DA=CLAIMIEN
S DA(9002313.0201)=TRXIEN
S DA(9002313.0401)=BPCOBIEN
S DR="400" ; field (#400) TRANSACTIONS
S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS
S DR(9002313.0401)=".01;338;339;340;341;443;471;353;392;993;2149" ; fields
S DIQ="BPS",DIQ(0)="I"
D EN^DIQ1
;
; Loop through PAYER AMT and get the data
S BPSPAMT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,1,0)),U,4)
F BPSCNT=1:1:BPSPAMT D GETBPS6(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
;
; Loop through OTHER PAYER REJECT CODE multiple and get the data
S BPREJCT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,2,0)),U,4)
F BPSCNT=1:1:BPREJCT D GETBPS7(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
;
; Loop through PAYER-PATIENT RESP and get the data
S BPSPAMT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,3,0)),U,4)
F BPSCNT=1:1:BPSPAMT D GETBPS8(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
;
; Loop through BENEFIT STAGES and get the data
S BPSPAMT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,4,0)),U,4)
F BPSCNT=1:1:BPSPAMT D GETBPS9(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
Q
;
; Other Payer Amt Paid multiple (#9002313.401342)
GETBPS6(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(TRXIEN)=""
Q:$G(BPCOBIEN)=""
Q:$G(BPPAYAMT)=""
;
N D0,DA,DIC,DIQ,DIQ2,DR
S DIC=9002313.02
S DA=CLAIMIEN
S DA(9002313.0201)=TRXIEN
S DA(9002313.0401)=BPCOBIEN
S DA(9002313.401342)=BPPAYAMT
S DR="400" ; field (#400) TRANSACTIONS
S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS
S DR(9002313.0401)=342 ;(#342) OTHER PAYER AMT PAID MULTIPLE
S DR(9002313.401342)=".01;431" ;fields
S DIQ="BPS",DIQ(0)="I"
D EN^DIQ1
;
Q
;
; Other Payer Reject Code multiple (#9002313.401472)
GETBPS7(CLAIMIEN,TRXIEN,BPCOBIEN,BPREJCT,BPS) ;EP - from GETBPS5
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(TRXIEN)=""
Q:$G(BPCOBIEN)=""
Q:$G(BPREJCT)=""
;
N D0,DA,DIC,DIQ,DIQ2,DR
;
S DIC=9002313.02
S DA=CLAIMIEN
S DA(9002313.0201)=TRXIEN
S DA(9002313.0401)=BPCOBIEN
S DA(9002313.401472)=BPREJCT
S DR="400" ; field (#400) TRANSACTIONS
S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS
S DR(9002313.0401)=472 ;(#472) OTHER PAYER REJECT CODE MLTPL
S DR(9002313.401472)=".01" ;fields
S DIQ="BPS",DIQ(0)="I"
D EN^DIQ1
Q
;
; Other Payer-Patient Resp Amt multiple (#9002313.401353)
GETBPS8(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(TRXIEN)=""
Q:$G(BPCOBIEN)=""
Q:$G(BPPAYAMT)=""
;
N D0,DA,DIC,DIQ,DIQ2,DR
S DIC=9002313.02
S DA=CLAIMIEN
S DA(9002313.0201)=TRXIEN
S DA(9002313.0401)=BPCOBIEN
S DA(9002313.401353)=BPPAYAMT
S DR="400" ; field (#400) TRANSACTIONS
S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS
S DR(9002313.0401)=353.01 ;field (#353.01) OTHER PAYER-PATIENT RESP MLTPL
S DR(9002313.401353)=".01;351;352" ;fields
S DIQ="BPS",DIQ(0)="I"
D EN^DIQ1
;
Q
;
; Benefit Stages multiple (#9002313.401392)
GETBPS9(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5
;
;Make sure input variables are defined
Q:$G(CLAIMIEN)=""
Q:$G(TRXIEN)=""
Q:$G(BPCOBIEN)=""
Q:$G(BPPAYAMT)=""
;
N D0,DA,DIC,DIQ,DIQ2,DR
S DIC=9002313.02
S DA=CLAIMIEN
S DA(9002313.0201)=TRXIEN
S DA(9002313.0401)=BPCOBIEN
S DA(9002313.401392)=BPPAYAMT
S DR="400" ; field (#400) TRANSACTIONS
S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS
S DR(9002313.0401)=392.01 ;field (#392.01) BENEFIT STAGE MLTPL
S DR(9002313.401392)=".01;393;394" ;fields
S DIQ="BPS",DIQ(0)="I"
D EN^DIQ1
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSECX0 8243 printed Apr 09, 2024@20:56:36 Page 2
BPSECX0 ;BHAM ISC/FCS/DRS/VA/DLF - Retrieve Claim submission record ;05/17/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,15,19,23,24,27**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine is used to pull data from BPS Claims and its multiples
+5 ; GETBPS2 - BPS Claims level
+6 ; GETBPS3 - Transaction subfile
+7 ; GETBPS4 - DUR subfile
+8 ; GETBPS5 - COB subfile. GETBPS5 calls the following
+9 ; GETBPS6 - Other Payer Amount Paid subfile
+10 ; GETBPS7 - Other Payer Reject Code subfile
+11 ; GETBPS8 - Other Payer Patient Responsibility subfile
+12 ; GETBPS9 - Benefits Stage subfile
+13 ;
+14 QUIT
+15 ;
+16 ; Retrieve BPS CLAIMS data
+17 ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
+18 ; BPS - Passed by reference
+19 ; returns: BPS(9002313.02,CLAIMIEN,field #,"I") = internal format value
GETBPS2(CLAIMIEN,BPS) ; called from BPSECA1 > BPSOSQG > BPSOSQ2
+1 ;
+2 ; must have claim IEN
if $GET(CLAIMIEN)=""
QUIT
+3 ;
+4 NEW D0,DA,DIC,DIQ,DIQ2,DR
+5 ;
+6 ; all fields from 101-899 and 990-997, skip 901-908 (used for BPS overhead)
SET DIC=9002313.02
SET DR="101:899;980:997"
+7 ;Get alphanumeric NCPDP fields 1022 (A22), 1043 (A23) and 1045 (A45)- BPS*1*15
SET DR=DR_";1022;1043;1045"
+8 ;Get alphanumeric NCPDP fields 2008 (B08), 2009 (B09) and 2038 (B38) - BPS*1*19
SET DR=DR_";2008;2009;2038"
+9 ;Get alphanumeric NCPDP fields 2306 (E06), 2309 (E09), 2310 (E10) and 2311 (E11) - BPS*1*27
SET DR=DR_";2306;2309:2311"
+10 ; "I" for internal format
SET DA=CLAIMIEN
SET DIQ="BPS"
SET DIQ(0)="I"
+11 DO EN^DIQ1
+12 QUIT
+13 ;
+14 ;Retrieve data in TRANSACTIONS multiple in BPS CLAIMS
+15 ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
+16 ; TRXIEN = ien in TRANSACTIONS (#9002313.0201)
+17 ; BPS - Passed by reference
+18 ; returns: BPS(9002313.0201,TRXIEN,field #,"I") = internal format value
GETBPS3(CLAIMIEN,TRXIEN,BPS) ;called from BPSECA1
+1 ;
+2 ; must have both
if $GET(CLAIMIEN)=""
QUIT
if $GET(TRXIEN)=""
QUIT
+3 ;
+4 NEW D0,DA,DIC,DIQ,DIQ2,DR
+5 ;
+6 ; There are other alphanumeric fields that could be added but since they are for segments that are not
+7 ; supported by E1, B1, B3 transactions and/or not segments not used by VA. These can be added later, if
+8 ; needed for those segments.
+9 ; all TRANSACTION fields
SET DIC=9002313.02
SET DR="400"
SET DR(9002313.0201)="113:996"
+10 SET DR(9002313.0201)=DR(9002313.0201)_";1023:1032"
+11 SET DR(9002313.0201)=DR(9002313.0201)_";2024:2032;2039:2043"
+12 SET DR(9002313.0201)=DR(9002313.0201)_";1093;2013:2021;2034;2035;2037"
+13 SET DR(9002313.0201)=DR(9002313.0201)_";2056:2061;2095:2097;2101;2102"
+14 ; new fields added in 2017 NCPDP updates
+15 SET DR(9002313.0201)=DR(9002313.0201)_";2147;2149;2150;2151;2160;2190;2191"
+16 SET DR(9002313.0201)=DR(9002313.0201)_";2192;2198;2199;2201;2202;2214;2216"
+17 SET DR(9002313.0201)=DR(9002313.0201)_";2217;2218;2221;2222;2251;2252;2253"
+18 SET DR(9002313.0201)=DR(9002313.0201)_";2257;2260;2261;2263;2312"
+19 ;
+20 ; IEN and sub-file IEN
SET DA=CLAIMIEN
SET DA(9002313.0201)=TRXIEN
+21 ; "I" for internal format
SET DIQ="BPS"
SET DIQ(0)="I"
+22 DO EN^DIQ1
+23 ;
+24 ; Copy Prescriber Phone Number (498.12) to field 498 as this is where BPSOSH2
+25 ; expects to find it. This works for now but if we implement the Prior Auth
+26 ; segment (which has multiple field labelled 498), a more complete solution
+27 ; will need to be found
+28 SET BPS(9002313.0201,TRXIEN,498,"I")=$GET(BPS(9002313.0201,TRXIEN,498.12,"I"))
+29 QUIT
+30 ;
+31 ;Retrieve DUR/PPS multiple data
+32 ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
+33 ; TRXIEN = ien in TRANSACTIONS (#9002313.0201)
+34 ; CDURIEN= DUR/PPS Multiple IEN (9002313.1001)
+35 ; BPS - Passed by reference
+36 ; returns: BPS(9002313.1001,CDURIEN,field #,"I") = Value
GETBPS4(CLAIMIEN,TRXIEN,CDURIEN,BPS) ;EP - from BPSECA1
+1 ;
+2 ;Make sure input variables are defined
+3 if $GET(CLAIMIEN)=""
QUIT
+4 if $GET(TRXIEN)=""
QUIT
+5 if $GET(CDURIEN)=""
QUIT
+6 ;
+7 NEW D0,DA,DIC,DIQ,DIQ2,DR
+8 SET DIC=9002313.02
+9 ;fields
SET DR="400"
SET DR(9002313.0201)=473.01
+10 ;fields
SET DR(9002313.1001)=".01;439;440;441;474;475;476"
+11 SET DA=CLAIMIEN
SET DA(9002313.0201)=TRXIEN
SET DA(9002313.1001)=CDURIEN
+12 SET DIQ="BPS"
SET DIQ(0)="I"
+13 DO EN^DIQ1
+14 ;
+15 QUIT
+16 ;
+17 ;Retrieve COB OTHER PAYMENTS multiple data
+18 ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02)
+19 ; TRXIEN = ien in TRANSACTIONS (#9002313.0201)
+20 ; BPCOBIEN= ien in COB OTHER PAYMENTS (#9002313.0401)
+21 ; BPS - Passed by reference
+22 ; Output: BPS(9002313.0401,BPCOBIEN,field #,"I") = Value
GETBPS5(CLAIMIEN,TRXIEN,BPCOBIEN,BPS) ;EP - from BPSECA1
+1 ;
+2 if $GET(CLAIMIEN)=""
QUIT
if $GET(TRXIEN)=""
QUIT
if $GET(BPCOBIEN)=""
QUIT
+3 ;
+4 NEW BPREJCT,BPSCNT,BPSPAMT,BPSOTHR,D0,DA,DIC,DIQ,DIQ2,DR
+5 ;
+6 SET DIC=9002313.02
+7 SET DA=CLAIMIEN
+8 SET DA(9002313.0201)=TRXIEN
+9 SET DA(9002313.0401)=BPCOBIEN
+10 ; field (#400) TRANSACTIONS
SET DR="400"
+11 ;field (#337.01) COB OTHER PAYMENTS
SET DR(9002313.0201)=337.01
+12 ; fields
SET DR(9002313.0401)=".01;338;339;340;341;443;471;353;392;993;2149"
+13 SET DIQ="BPS"
SET DIQ(0)="I"
+14 DO EN^DIQ1
+15 ;
+16 ; Loop through PAYER AMT and get the data
+17 SET BPSPAMT=$PIECE($GET(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,1,0)),U,4)
+18 FOR BPSCNT=1:1:BPSPAMT
DO GETBPS6(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
+19 ;
+20 ; Loop through OTHER PAYER REJECT CODE multiple and get the data
+21 SET BPREJCT=$PIECE($GET(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,2,0)),U,4)
+22 FOR BPSCNT=1:1:BPREJCT
DO GETBPS7(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
+23 ;
+24 ; Loop through PAYER-PATIENT RESP and get the data
+25 SET BPSPAMT=$PIECE($GET(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,3,0)),U,4)
+26 FOR BPSCNT=1:1:BPSPAMT
DO GETBPS8(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
+27 ;
+28 ; Loop through BENEFIT STAGES and get the data
+29 SET BPSPAMT=$PIECE($GET(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,4,0)),U,4)
+30 FOR BPSCNT=1:1:BPSPAMT
DO GETBPS9(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS)
+31 QUIT
+32 ;
+33 ; Other Payer Amt Paid multiple (#9002313.401342)
GETBPS6(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5
+1 ;
+2 ;Make sure input variables are defined
+3 if $GET(CLAIMIEN)=""
QUIT
+4 if $GET(TRXIEN)=""
QUIT
+5 if $GET(BPCOBIEN)=""
QUIT
+6 if $GET(BPPAYAMT)=""
QUIT
+7 ;
+8 NEW D0,DA,DIC,DIQ,DIQ2,DR
+9 SET DIC=9002313.02
+10 SET DA=CLAIMIEN
+11 SET DA(9002313.0201)=TRXIEN
+12 SET DA(9002313.0401)=BPCOBIEN
+13 SET DA(9002313.401342)=BPPAYAMT
+14 ; field (#400) TRANSACTIONS
SET DR="400"
+15 ;field (#337.01) COB OTHER PAYMENTS
SET DR(9002313.0201)=337.01
+16 ;(#342) OTHER PAYER AMT PAID MULTIPLE
SET DR(9002313.0401)=342
+17 ;fields
SET DR(9002313.401342)=".01;431"
+18 SET DIQ="BPS"
SET DIQ(0)="I"
+19 DO EN^DIQ1
+20 ;
+21 QUIT
+22 ;
+23 ; Other Payer Reject Code multiple (#9002313.401472)
GETBPS7(CLAIMIEN,TRXIEN,BPCOBIEN,BPREJCT,BPS) ;EP - from GETBPS5
+1 ;
+2 ;Make sure input variables are defined
+3 if $GET(CLAIMIEN)=""
QUIT
+4 if $GET(TRXIEN)=""
QUIT
+5 if $GET(BPCOBIEN)=""
QUIT
+6 if $GET(BPREJCT)=""
QUIT
+7 ;
+8 NEW D0,DA,DIC,DIQ,DIQ2,DR
+9 ;
+10 SET DIC=9002313.02
+11 SET DA=CLAIMIEN
+12 SET DA(9002313.0201)=TRXIEN
+13 SET DA(9002313.0401)=BPCOBIEN
+14 SET DA(9002313.401472)=BPREJCT
+15 ; field (#400) TRANSACTIONS
SET DR="400"
+16 ;field (#337.01) COB OTHER PAYMENTS
SET DR(9002313.0201)=337.01
+17 ;(#472) OTHER PAYER REJECT CODE MLTPL
SET DR(9002313.0401)=472
+18 ;fields
SET DR(9002313.401472)=".01"
+19 SET DIQ="BPS"
SET DIQ(0)="I"
+20 DO EN^DIQ1
+21 QUIT
+22 ;
+23 ; Other Payer-Patient Resp Amt multiple (#9002313.401353)
GETBPS8(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5
+1 ;
+2 ;Make sure input variables are defined
+3 if $GET(CLAIMIEN)=""
QUIT
+4 if $GET(TRXIEN)=""
QUIT
+5 if $GET(BPCOBIEN)=""
QUIT
+6 if $GET(BPPAYAMT)=""
QUIT
+7 ;
+8 NEW D0,DA,DIC,DIQ,DIQ2,DR
+9 SET DIC=9002313.02
+10 SET DA=CLAIMIEN
+11 SET DA(9002313.0201)=TRXIEN
+12 SET DA(9002313.0401)=BPCOBIEN
+13 SET DA(9002313.401353)=BPPAYAMT
+14 ; field (#400) TRANSACTIONS
SET DR="400"
+15 ;field (#337.01) COB OTHER PAYMENTS
SET DR(9002313.0201)=337.01
+16 ;field (#353.01) OTHER PAYER-PATIENT RESP MLTPL
SET DR(9002313.0401)=353.01
+17 ;fields
SET DR(9002313.401353)=".01;351;352"
+18 SET DIQ="BPS"
SET DIQ(0)="I"
+19 DO EN^DIQ1
+20 ;
+21 QUIT
+22 ;
+23 ; Benefit Stages multiple (#9002313.401392)
GETBPS9(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5
+1 ;
+2 ;Make sure input variables are defined
+3 if $GET(CLAIMIEN)=""
QUIT
+4 if $GET(TRXIEN)=""
QUIT
+5 if $GET(BPCOBIEN)=""
QUIT
+6 if $GET(BPPAYAMT)=""
QUIT
+7 ;
+8 NEW D0,DA,DIC,DIQ,DIQ2,DR
+9 SET DIC=9002313.02
+10 SET DA=CLAIMIEN
+11 SET DA(9002313.0201)=TRXIEN
+12 SET DA(9002313.0401)=BPCOBIEN
+13 SET DA(9002313.401392)=BPPAYAMT
+14 ; field (#400) TRANSACTIONS
SET DR="400"
+15 ;field (#337.01) COB OTHER PAYMENTS
SET DR(9002313.0201)=337.01
+16 ;field (#392.01) BENEFIT STAGE MLTPL
SET DR(9002313.0401)=392.01
+17 ;fields
SET DR(9002313.401392)=".01;393;394"
+18 SET DIQ="BPS"
SET DIQ(0)="I"
+19 DO EN^DIQ1
+20 ;
+21 QUIT
