BPSOSRX4 ;ALB/SS - ECME REQUESTS ;04-JAN-08
;;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.
;
Q
;restore MOREDATA from the file 9002313.77
READMORE(BPIEN77,MOREDATA) ;
N BPIEN772,BPCOB,BPIEN78,BPACTTYP,BPDURCNT,BPPAYSEQ
S MOREDATA("REQ IEN")=BPIEN77
S MOREDATA("REQ DTTM")=$P($G(^BPS(9002313.77,BPIEN77,6)),U,1) ;6.01
S MOREDATA("USER")=$P($G(^BPS(9002313.77,BPIEN77,6)),U,2) ;6.02
S BPPAYSEQ=$P($G(^BPS(9002313.77,BPIEN77,0)),U,3)
S BPPAYSEQ=$S(BPPAYSEQ:BPPAYSEQ,1:1)
S MOREDATA("PAYER SEQUENCE")=BPPAYSEQ
S MOREDATA("RX ACTION")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,1) ;1.01
S BPACTTYP=MOREDATA("RX ACTION")
S MOREDATA("DIVISION")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,2) ;1,02
S MOREDATA("REQ TYPE")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,4) ;1,04
S MOREDATA("ELIG")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1.06
S $P(MOREDATA("BILL"),U,1)=$P($G(^BPS(9002313.77,BPIEN77,1)),U,5) ;1,05
S $P(MOREDATA("BILL"),U,2)=$P($G(^BPS(9002313.77,BPIEN77,1)),U,7) ;1,07
S $P(MOREDATA("BILL"),U,3)=$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1,06
;S MOREDATA("BILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,5)_U_$P($G(^BPS(9002313.77,BPIEN77,1)),U,7)_U_$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1,05^1.07^1.06
S MOREDATA("RX")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,13)
S MOREDATA("FILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,14)
S MOREDATA("PATIENT")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,15)
S MOREDATA("POLICY")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,16)
S MOREDATA("DATE OF SERVICE")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,1) ;2.01
S MOREDATA("REVERSAL REASON")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,2) ;2.02
S $P(MOREDATA("BPSDATA",1),U,1)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,1) ;NCPCP Quantity
S $P(MOREDATA("BPSDATA",1),U,2)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,2) ;Unit Cost
S $P(MOREDATA("BPSDATA",1),U,3)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,3) ;NDC
S $P(MOREDATA("BPSDATA",1),U,4)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,4) ;Fill Number
S $P(MOREDATA("BPSDATA",1),U,5)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,5) ;Certification Mode
S $P(MOREDATA("BPSDATA",1),U,6)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,6) ;Certification IEN
S $P(MOREDATA("BPSDATA",1),U,7)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,7) ;Unit of Measure
S $P(MOREDATA("BPSDATA",1),U,8)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,8) ;Billing Quantity
S $P(MOREDATA("BPSDATA",1),U,9)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,9) ;Billing Units
I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,4))>0 S MOREDATA("BPOVRIEN")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,4) ;override code (RED option)
I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,5))>0 S MOREDATA("BPSCLARF")=$$GET1^DIQ(9002313.77,BPIEN77_",",2.05,"E") ; clarification code
I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,7))>0 S $P(MOREDATA("BPSAUTH"),U,1)=$P($G(^BPS(9002313.77,BPIEN77,2)),U,7) ;preauth.code
I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,8))>0 S $P(MOREDATA("BPSAUTH"),U,2)=$P($G(^BPS(9002313.77,BPIEN77,2)),U,8) ;preauth number
I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,10))>0 S MOREDATA("BPSDELAY")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,10) ;Delay Reason Code
;DUR override codes Reason for Service Code, Professional Service Code, Result of Service Code
;
S MOREDATA("RTYPE")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,8)
I BPPAYSEQ=2 D
. S MOREDATA("PRIMARY BILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,9)
. S MOREDATA("PRIOR PAYMENT")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,10)
. S MOREDATA("337-4C")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,11) ;1.11 cob other payments count
. S MOREDATA("308-C8")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,12) ;1.12 other coverage code
. ;
. ; build COB data array - esg - 6/10/10
. N COBPIEN,APDIEN,REJIEN
. K MOREDATA("OTHER PAYER")
. S COBPIEN=0 F S COBPIEN=$O(^BPS(9002313.77,BPIEN77,8,COBPIEN)) Q:'COBPIEN D
.. S MOREDATA("OTHER PAYER",COBPIEN,0)=$G(^BPS(9002313.77,BPIEN77,8,COBPIEN,0))
.. ;
.. ; retrieve data from other payer amount paid multiple
.. S APDIEN=0 F S APDIEN=$O(^BPS(9002313.77,BPIEN77,8,COBPIEN,1,APDIEN)) Q:'APDIEN D
... S MOREDATA("OTHER PAYER",COBPIEN,"P",APDIEN,0)=$G(^BPS(9002313.77,BPIEN77,8,COBPIEN,1,APDIEN,0))
... Q
.. ;
.. ; retrieve data from other payer reject multiple
.. S REJIEN=0 F S REJIEN=$O(^BPS(9002313.77,BPIEN77,8,COBPIEN,2,REJIEN)) Q:'REJIEN D
... S MOREDATA("OTHER PAYER",COBPIEN,"R",REJIEN,0)=$G(^BPS(9002313.77,BPIEN77,8,COBPIEN,2,REJIEN,0))
... Q
.. Q
. Q
;
S BPDURCNT=0 F S BPDURCNT=$O(^BPS(9002313.77,BPIEN77,3,BPDURCNT)) Q:+BPDURCNT=0 D
. S MOREDATA("DUR",BPDURCNT,0)=$G(^BPS(9002313.77,BPIEN77,3,BPDURCNT,0))
;
S BPIEN772=0 F S BPIEN772=$O(^BPS(9002313.77,BPIEN77,5,BPIEN772)) Q:+BPIEN772=0 D
. S BPCOB=+$G(^BPS(9002313.77,BPIEN77,5,BPIEN772,0)) ;.01
. S BPIEN78=+$P($G(^BPS(9002313.77,BPIEN77,5,BPIEN772,0)),U,3) ;.03
. S $P(MOREDATA("IBDATA",BPCOB,1),U,1)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,8) ;.08
. S $P(MOREDATA("IBDATA",BPCOB,1),U,2)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,1) ;1.01
. S $P(MOREDATA("IBDATA",BPCOB,1),U,3)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,2) ;1.02
. S $P(MOREDATA("IBDATA",BPCOB,1),U,4)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,1) ;4.01-billing payer sheet name
. S $P(MOREDATA("IBDATA",BPCOB,1),U,5)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,3) ;1.03
. S $P(MOREDATA("IBDATA",BPCOB,1),U,6)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,4) ;1.04
. S $P(MOREDATA("IBDATA",BPCOB,1),U,7)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,5) ;1.05
. S $P(MOREDATA("IBDATA",BPCOB,1),U,8)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,6) ;1.06
. S $P(MOREDATA("IBDATA",BPCOB,1),U,9)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,7) ;1.07
. S $P(MOREDATA("IBDATA",BPCOB,1),U,10)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,8) ;1.08
. S $P(MOREDATA("IBDATA",BPCOB,1),U,11)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,2) ;4.02-reversal payer sheet name
. S $P(MOREDATA("IBDATA",BPCOB,1),U,12)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,3) ;4.03-rebill payer sheet name
. S $P(MOREDATA("IBDATA",BPCOB,1),U,13)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,6) ;2.06
. S $P(MOREDATA("IBDATA",BPCOB,1),U,14)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,7) ;.07
. S $P(MOREDATA("IBDATA",BPCOB,1),U,15)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,4) ;4.04-eligibility payer sheet name
. S $P(MOREDATA("IBDATA",BPCOB,1),U,16)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,2) ;.02-billing payer sheet IEN
. S $P(MOREDATA("IBDATA",BPCOB,1),U,17)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,3) ;.03-reversal payer sheet IEN
. S $P(MOREDATA("IBDATA",BPCOB,1),U,18)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,4) ;.04-rebill payer sheet IEN
. S $P(MOREDATA("IBDATA",BPCOB,1),U,19)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,10) ;.1-eligibility payer sheet IEN
. S $P(MOREDATA("IBDATA",BPCOB,1),U,20)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,9) ;1.09-Person Code
. S $P(MOREDATA("IBDATA",BPCOB,2),U,1)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,1) ;2.01-Dispensing Fee
. S $P(MOREDATA("IBDATA",BPCOB,2),U,2)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,2) ;2.02-Basis of Cost Determination
. S $P(MOREDATA("IBDATA",BPCOB,2),U,4)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,4) ;2.04-Gross Amount Due
. S $P(MOREDATA("IBDATA",BPCOB,2),U,5)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,5) ;2.05-Admin Fee
. S $P(MOREDATA("IBDATA",BPCOB,2),U,6)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,8) ;2.08-Ingredient Cost
. S $P(MOREDATA("IBDATA",BPCOB,2),U,7)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,3) ;2.03-U&C
. S $P(MOREDATA("IBDATA",BPCOB,3),U,1)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,1) ;3.01
. S $P(MOREDATA("IBDATA",BPCOB,3),U,2)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,2) ;3.02
. S $P(MOREDATA("IBDATA",BPCOB,3),U,3)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,3) ;3.03
. S $P(MOREDATA("IBDATA",BPCOB,3),U,4)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,4) ;3.04-eligibility
. S $P(MOREDATA("IBDATA",BPCOB,3),U,5)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,5) ;3.05-insurance ien
. S $P(MOREDATA("IBDATA",BPCOB,3),U,6)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,6) ;3.06-COB
. S $P(MOREDATA("IBDATA",BPCOB,3),U,7)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,11) ;.11
. S $P(MOREDATA("IBDATA",BPCOB,3),U,8)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,7) ;2.07
Q
;
;change Process flag to "COMPLETED"
COMPLETD(BPIEN77) ;
Q $$CHNGPRFL^BPSOSRX6(BPIEN77,3)
;
;inactivate BPS REQUEST
INACTIVE(BPIEN77,ERROR) ;
I '$$CHNGPRFL^BPSOSRX6(BPIEN77,5) Q 0
I $G(ERROR)]"",$$FILLFLDS^BPSUTIL2(9002313.77,"9.01",BPIEN77,ERROR)<1 Q "0^Cannot update field #9.01 (INACTIVATION REASON) in BPS REQUEST"
Q 1
;activate the request - change Process flag to "ACTIVATED"
ACTIVATE(BPIEN77) ;
;do we need to check what was the status of previous one - if it was rejected then we shouldn't activate it?
Q $$CHNGPRFL^BPSOSRX6(BPIEN77,1)
;
;change Process flag to "IN PROCESS"
INPROCES(BPIEN77) ;
Q $$CHNGPRFL^BPSOSRX6(BPIEN77,2)
;
;delete BPS REQUEST record
DELREQST(BPIEN77,IEN59) ;
N BPCOB
N DIK,DA
I $$INACTIVE(BPIEN77,"DELREQST was called")
;Q
S BPCOB=0
F S BPCOB=$O(^BPS(9002313.77,BPIEN77,5,BPCOB)) Q:+BPCOB=0 D
. S DIK="^BPS(9002313.78,"
. S DA=+$P($G(^BPS(9002313.77,BPIEN77,5,BPCOB,0)),U,3)
. D ^DIK
;
S DIK="^BPS(9002313.77,"
S DA=BPIEN77
D ^DIK
;
I $G(IEN59) D LOG^BPSOSL(IEN59,$T(+0)_"-Request "_BPIEN77_" and associated BPS INSURER DATA records were deleted")
Q
;
;update fields in BPS REQUEST with BPS TRANSACTION data
UPD7759(BP77,IEN59) ;
N BPZ
I +$G(BP77)=0!(+$G(IEN59)=0) Q
D LOG^BPSOSL(IEN59,$T(+0)_"-Populating fields in BPS Request "_BP77)
I $$FILLFLDS^BPSUTIL2(9002313.77,".06",BP77,IEN59)<1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.06) of (#9002313.77)")
S BPZ=$$UPUSRTIM^BPSOSRX6(BP77,$S($G(DUZ):+DUZ,1:.5)) I +BPZ=0 D LOG^BPSOSL(IEN59,$T(+0)_$P(BPZ,U,2))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSRX4 9745 printed Dec 13, 2024@01:52:02 Page 2
BPSOSRX4 ;ALB/SS - ECME REQUESTS ;04-JAN-08
+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 QUIT
+5 ;restore MOREDATA from the file 9002313.77
READMORE(BPIEN77,MOREDATA) ;
+1 NEW BPIEN772,BPCOB,BPIEN78,BPACTTYP,BPDURCNT,BPPAYSEQ
+2 SET MOREDATA("REQ IEN")=BPIEN77
+3 ;6.01
SET MOREDATA("REQ DTTM")=$PIECE($GET(^BPS(9002313.77,BPIEN77,6)),U,1)
+4 ;6.02
SET MOREDATA("USER")=$PIECE($GET(^BPS(9002313.77,BPIEN77,6)),U,2)
+5 SET BPPAYSEQ=$PIECE($GET(^BPS(9002313.77,BPIEN77,0)),U,3)
+6 SET BPPAYSEQ=$SELECT(BPPAYSEQ:BPPAYSEQ,1:1)
+7 SET MOREDATA("PAYER SEQUENCE")=BPPAYSEQ
+8 ;1.01
SET MOREDATA("RX ACTION")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,1)
+9 SET BPACTTYP=MOREDATA("RX ACTION")
+10 ;1,02
SET MOREDATA("DIVISION")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,2)
+11 ;1,04
SET MOREDATA("REQ TYPE")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,4)
+12 ;1.06
SET MOREDATA("ELIG")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,6)
+13 ;1,05
SET $PIECE(MOREDATA("BILL"),U,1)=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,5)
+14 ;1,07
SET $PIECE(MOREDATA("BILL"),U,2)=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,7)
+15 ;1,06
SET $PIECE(MOREDATA("BILL"),U,3)=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,6)
+16 ;S MOREDATA("BILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,5)_U_$P($G(^BPS(9002313.77,BPIEN77,1)),U,7)_U_$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1,05^1.07^1.06
+17 SET MOREDATA("RX")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,13)
+18 SET MOREDATA("FILL")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,14)
+19 SET MOREDATA("PATIENT")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,15)
+20 SET MOREDATA("POLICY")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,16)
+21 ;2.01
SET MOREDATA("DATE OF SERVICE")=$PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,1)
+22 ;2.02
SET MOREDATA("REVERSAL REASON")=$PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,2)
+23 ;NCPCP Quantity
SET $PIECE(MOREDATA("BPSDATA",1),U,1)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,1)
+24 ;Unit Cost
SET $PIECE(MOREDATA("BPSDATA",1),U,2)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,2)
+25 ;NDC
SET $PIECE(MOREDATA("BPSDATA",1),U,3)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,3)
+26 ;Fill Number
SET $PIECE(MOREDATA("BPSDATA",1),U,4)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,4)
+27 ;Certification Mode
SET $PIECE(MOREDATA("BPSDATA",1),U,5)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,5)
+28 ;Certification IEN
SET $PIECE(MOREDATA("BPSDATA",1),U,6)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,6)
+29 ;Unit of Measure
SET $PIECE(MOREDATA("BPSDATA",1),U,7)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,7)
+30 ;Billing Quantity
SET $PIECE(MOREDATA("BPSDATA",1),U,8)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,8)
+31 ;Billing Units
SET $PIECE(MOREDATA("BPSDATA",1),U,9)=$PIECE($GET(^BPS(9002313.77,BPIEN77,4)),U,9)
+32 ;override code (RED option)
IF $LENGTH($PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,4))>0
SET MOREDATA("BPOVRIEN")=$PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,4)
+33 ; clarification code
IF $LENGTH($PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,5))>0
SET MOREDATA("BPSCLARF")=$$GET1^DIQ(9002313.77,BPIEN77_",",2.05,"E")
+34 ;preauth.code
IF $LENGTH($PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,7))>0
SET $PIECE(MOREDATA("BPSAUTH"),U,1)=$PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,7)
+35 ;preauth number
IF $LENGTH($PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,8))>0
SET $PIECE(MOREDATA("BPSAUTH"),U,2)=$PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,8)
+36 ;Delay Reason Code
IF $LENGTH($PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,10))>0
SET MOREDATA("BPSDELAY")=$PIECE($GET(^BPS(9002313.77,BPIEN77,2)),U,10)
+37 ;DUR override codes Reason for Service Code, Professional Service Code, Result of Service Code
+38 ;
+39 SET MOREDATA("RTYPE")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,8)
+40 IF BPPAYSEQ=2
Begin DoDot:1
+41 SET MOREDATA("PRIMARY BILL")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,9)
+42 SET MOREDATA("PRIOR PAYMENT")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,10)
+43 ;1.11 cob other payments count
SET MOREDATA("337-4C")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,11)
+44 ;1.12 other coverage code
SET MOREDATA("308-C8")=$PIECE($GET(^BPS(9002313.77,BPIEN77,1)),U,12)
+45 ;
+46 ; build COB data array - esg - 6/10/10
+47 NEW COBPIEN,APDIEN,REJIEN
+48 KILL MOREDATA("OTHER PAYER")
+49 SET COBPIEN=0
FOR
SET COBPIEN=$ORDER(^BPS(9002313.77,BPIEN77,8,COBPIEN))
if 'COBPIEN
QUIT
Begin DoDot:2
+50 SET MOREDATA("OTHER PAYER",COBPIEN,0)=$GET(^BPS(9002313.77,BPIEN77,8,COBPIEN,0))
+51 ;
+52 ; retrieve data from other payer amount paid multiple
+53 SET APDIEN=0
FOR
SET APDIEN=$ORDER(^BPS(9002313.77,BPIEN77,8,COBPIEN,1,APDIEN))
if 'APDIEN
QUIT
Begin DoDot:3
+54 SET MOREDATA("OTHER PAYER",COBPIEN,"P",APDIEN,0)=$GET(^BPS(9002313.77,BPIEN77,8,COBPIEN,1,APDIEN,0))
+55 QUIT
End DoDot:3
+56 ;
+57 ; retrieve data from other payer reject multiple
+58 SET REJIEN=0
FOR
SET REJIEN=$ORDER(^BPS(9002313.77,BPIEN77,8,COBPIEN,2,REJIEN))
if 'REJIEN
QUIT
Begin DoDot:3
+59 SET MOREDATA("OTHER PAYER",COBPIEN,"R",REJIEN,0)=$GET(^BPS(9002313.77,BPIEN77,8,COBPIEN,2,REJIEN,0))
+60 QUIT
End DoDot:3
+61 QUIT
End DoDot:2
+62 QUIT
End DoDot:1
+63 ;
+64 SET BPDURCNT=0
FOR
SET BPDURCNT=$ORDER(^BPS(9002313.77,BPIEN77,3,BPDURCNT))
if +BPDURCNT=0
QUIT
Begin DoDot:1
+65 SET MOREDATA("DUR",BPDURCNT,0)=$GET(^BPS(9002313.77,BPIEN77,3,BPDURCNT,0))
End DoDot:1
+66 ;
+67 SET BPIEN772=0
FOR
SET BPIEN772=$ORDER(^BPS(9002313.77,BPIEN77,5,BPIEN772))
if +BPIEN772=0
QUIT
Begin DoDot:1
+68 ;.01
SET BPCOB=+$GET(^BPS(9002313.77,BPIEN77,5,BPIEN772,0))
+69 ;.03
SET BPIEN78=+$PIECE($GET(^BPS(9002313.77,BPIEN77,5,BPIEN772,0)),U,3)
+70 ;.08
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,1)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,8)
+71 ;1.01
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,2)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,1)
+72 ;1.02
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,3)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,2)
+73 ;4.01-billing payer sheet name
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,4)=$PIECE($GET(^BPS(9002313.78,BPIEN78,4)),U,1)
+74 ;1.03
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,5)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,3)
+75 ;1.04
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,6)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,4)
+76 ;1.05
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,7)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,5)
+77 ;1.06
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,8)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,6)
+78 ;1.07
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,9)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,7)
+79 ;1.08
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,10)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,8)
+80 ;4.02-reversal payer sheet name
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,11)=$PIECE($GET(^BPS(9002313.78,BPIEN78,4)),U,2)
+81 ;4.03-rebill payer sheet name
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,12)=$PIECE($GET(^BPS(9002313.78,BPIEN78,4)),U,3)
+82 ;2.06
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,13)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,6)
+83 ;.07
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,14)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,7)
+84 ;4.04-eligibility payer sheet name
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,15)=$PIECE($GET(^BPS(9002313.78,BPIEN78,4)),U,4)
+85 ;.02-billing payer sheet IEN
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,16)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,2)
+86 ;.03-reversal payer sheet IEN
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,17)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,3)
+87 ;.04-rebill payer sheet IEN
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,18)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,4)
+88 ;.1-eligibility payer sheet IEN
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,19)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,10)
+89 ;1.09-Person Code
SET $PIECE(MOREDATA("IBDATA",BPCOB,1),U,20)=$PIECE($GET(^BPS(9002313.78,BPIEN78,1)),U,9)
+90 ;2.01-Dispensing Fee
SET $PIECE(MOREDATA("IBDATA",BPCOB,2),U,1)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,1)
+91 ;2.02-Basis of Cost Determination
SET $PIECE(MOREDATA("IBDATA",BPCOB,2),U,2)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,2)
+92 ;2.04-Gross Amount Due
SET $PIECE(MOREDATA("IBDATA",BPCOB,2),U,4)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,4)
+93 ;2.05-Admin Fee
SET $PIECE(MOREDATA("IBDATA",BPCOB,2),U,5)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,5)
+94 ;2.08-Ingredient Cost
SET $PIECE(MOREDATA("IBDATA",BPCOB,2),U,6)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,8)
+95 ;2.03-U&C
SET $PIECE(MOREDATA("IBDATA",BPCOB,2),U,7)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,3)
+96 ;3.01
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,1)=$PIECE($GET(^BPS(9002313.78,BPIEN78,3)),U,1)
+97 ;3.02
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,2)=$PIECE($GET(^BPS(9002313.78,BPIEN78,3)),U,2)
+98 ;3.03
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,3)=$PIECE($GET(^BPS(9002313.78,BPIEN78,3)),U,3)
+99 ;3.04-eligibility
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,4)=$PIECE($GET(^BPS(9002313.78,BPIEN78,3)),U,4)
+100 ;3.05-insurance ien
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,5)=$PIECE($GET(^BPS(9002313.78,BPIEN78,3)),U,5)
+101 ;3.06-COB
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,6)=$PIECE($GET(^BPS(9002313.78,BPIEN78,3)),U,6)
+102 ;.11
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,7)=$PIECE($GET(^BPS(9002313.78,BPIEN78,0)),U,11)
+103 ;2.07
SET $PIECE(MOREDATA("IBDATA",BPCOB,3),U,8)=$PIECE($GET(^BPS(9002313.78,BPIEN78,2)),U,7)
End DoDot:1
+104 QUIT
+105 ;
+106 ;change Process flag to "COMPLETED"
COMPLETD(BPIEN77) ;
+1 QUIT $$CHNGPRFL^BPSOSRX6(BPIEN77,3)
+2 ;
+3 ;inactivate BPS REQUEST
INACTIVE(BPIEN77,ERROR) ;
+1 IF '$$CHNGPRFL^BPSOSRX6(BPIEN77,5)
QUIT 0
+2 IF $GET(ERROR)]""
IF $$FILLFLDS^BPSUTIL2(9002313.77,"9.01",BPIEN77,ERROR)<1
QUIT "0^Cannot update field #9.01 (INACTIVATION REASON) in BPS REQUEST"
+3 QUIT 1
+4 ;activate the request - change Process flag to "ACTIVATED"
ACTIVATE(BPIEN77) ;
+1 ;do we need to check what was the status of previous one - if it was rejected then we shouldn't activate it?
+2 QUIT $$CHNGPRFL^BPSOSRX6(BPIEN77,1)
+3 ;
+4 ;change Process flag to "IN PROCESS"
INPROCES(BPIEN77) ;
+1 QUIT $$CHNGPRFL^BPSOSRX6(BPIEN77,2)
+2 ;
+3 ;delete BPS REQUEST record
DELREQST(BPIEN77,IEN59) ;
+1 NEW BPCOB
+2 NEW DIK,DA
+3 IF $$INACTIVE(BPIEN77,"DELREQST was called")
+4 ;Q
+5 SET BPCOB=0
+6 FOR
SET BPCOB=$ORDER(^BPS(9002313.77,BPIEN77,5,BPCOB))
if +BPCOB=0
QUIT
Begin DoDot:1
+7 SET DIK="^BPS(9002313.78,"
+8 SET DA=+$PIECE($GET(^BPS(9002313.77,BPIEN77,5,BPCOB,0)),U,3)
+9 DO ^DIK
End DoDot:1
+10 ;
+11 SET DIK="^BPS(9002313.77,"
+12 SET DA=BPIEN77
+13 DO ^DIK
+14 ;
+15 IF $GET(IEN59)
DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Request "_BPIEN77_" and associated BPS INSURER DATA records were deleted")
+16 QUIT
+17 ;
+18 ;update fields in BPS REQUEST with BPS TRANSACTION data
UPD7759(BP77,IEN59) ;
+1 NEW BPZ
+2 IF +$GET(BP77)=0!(+$GET(IEN59)=0)
QUIT
+3 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Populating fields in BPS Request "_BP77)
+4 IF $$FILLFLDS^BPSUTIL2(9002313.77,".06",BP77,IEN59)<1
DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Cannot populate (#.06) of (#9002313.77)")
+5 SET BPZ=$$UPUSRTIM^BPSOSRX6(BP77,$SELECT($GET(DUZ):+DUZ,1:.5))
IF +BPZ=0
DO LOG^BPSOSL(IEN59,$TEXT(+0)_$PIECE(BPZ,U,2))
+6 QUIT
+7 ;
