BPSOSCA ;BHAM ISC/FCS/DRS - Create BPS Claims entries ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
; Create BPS Claims entries for TRANLIST(*) claims.
; Called from PACKET^BPSOSQG
;
; Input:
; TRANLIST(IEN59) - Array of pointers to 9002313.59
; A list of transactions for the same visit/patient/etc.
; to be bundled into one or more 9002313.02 claims
;
; Outputs:
; CLAIMIEN(CLAIMIEN)="", pointers to the ^BPSC(CLAIMIEN,
; claim records created.
; ERROR
;
; BPSOSCA calls:
; BPSOSCB to build BPS(*) array
; (and BPSOSCB calls BPSOSCC and BPSOSCD)
; BPSOSCE to build the ^BPSC( entry
;
EN(CLAIMIEN) ;EP - from BPSOSQG
I $D(TRANLIST)<10 D Q "306^No TRANLIST defined"
. N RETVAL S RETVAL=$$IMPOSS^BPSOSUE("P","TI","Bad TRANLIST",,,$T(+0))
. D LOG2LIST^BPSOSL($T(+0)_"-No TRANLIST passed into BPSOSCA")
;
; Manage local variables
N BPS,START,END,TOTAL,NCLAIMS,CLAIMN,ERROR
S ERROR=$$BPS^BPSOSCB()
I ERROR D LOG2LIST^BPSOSL($T(+0)_"-$$BPS^BPSOSCB(.BPS) returned "_ERROR)
I $G(BPS("RX",0))="" S:'ERROR ERROR="301^BPS(""RX"" not created" Q ERROR
I $G(BPS("NCPDP","# Meds/Claim"))="" Q "302^Number of Meds not returned"
;
; Calculate number of claim records to be generated for Billing Item
S NCLAIMS=((BPS("RX",0)-1)\BPS("NCPDP","# Meds/Claim"))+1
I NCLAIMS=0 Q "303^Number of claims is zero"
;
;Generate claim submission records
F CLAIMN=1:1:NCLAIMS D Q:$G(ERROR)
. S START=((CLAIMN-1)*BPS("NCPDP","# Meds/Claim"))+1
. S END=START+BPS("NCPDP","# Meds/Claim")-1
. S:END>BPS("RX",0) END=BPS("RX",0)
. S TOTAL=END-START+1
. S ERROR=$$NEWCLAIM^BPSOSCE(START,END,TOTAL)
. I ERROR]"" Q
. S CLAIMIEN=BPS(9002313.02)
. S CLAIMIEN(CLAIMIEN)=""
. ; Mark each of the .59s with the claim number and position within
. F I=START:1:END D
.. ;
.. ; IEN59 handling 06/23/2000. The ELSE should never happen again.
.. ; and the $G() can probably be gotten rid of, safely.
.. N IEN59 S IEN59=$G(BPS("RX",I,"IEN59"))
.. I IEN59 D
... N DIE,DA,DR S DIE=9002313.59
... ;
... ; Field #3-CLAIM, #14-POSITION
... ; POSITION: Not the relative position within the packet,
... ; but the index in BPS("RX",n,.... This is the position in which
... ; it will be stored in ^BPSC(ien,400,POSITION
... ; and likewise for 9002313.03 when the response comes in.
... S DA=IEN59,DR=3_"////"_CLAIMIEN_";14////"_I N I D ^DIE
.. E D
... S $P(^BPST(BPS("RX",I,"RX IEN"),0),"^",4)=CLAIMIEN
... S ^BPST("AE",CLAIMIEN,BPS("RX",I,"RX IEN"))=""
... S $P(^BPST(BPS("RX",I,"RX IEN"),0),"^",9)=I
Q ERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSCA 2751 printed Sep 23, 2025@19:27:46 Page 2
BPSOSCA ;BHAM ISC/FCS/DRS - Create BPS Claims entries ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; Create BPS Claims entries for TRANLIST(*) claims.
+6 ; Called from PACKET^BPSOSQG
+7 ;
+8 ; Input:
+9 ; TRANLIST(IEN59) - Array of pointers to 9002313.59
+10 ; A list of transactions for the same visit/patient/etc.
+11 ; to be bundled into one or more 9002313.02 claims
+12 ;
+13 ; Outputs:
+14 ; CLAIMIEN(CLAIMIEN)="", pointers to the ^BPSC(CLAIMIEN,
+15 ; claim records created.
+16 ; ERROR
+17 ;
+18 ; BPSOSCA calls:
+19 ; BPSOSCB to build BPS(*) array
+20 ; (and BPSOSCB calls BPSOSCC and BPSOSCD)
+21 ; BPSOSCE to build the ^BPSC( entry
+22 ;
EN(CLAIMIEN) ;EP - from BPSOSQG
+1 IF $DATA(TRANLIST)<10
Begin DoDot:1
+2 NEW RETVAL
SET RETVAL=$$IMPOSS^BPSOSUE("P","TI","Bad TRANLIST",,,$TEXT(+0))
+3 DO LOG2LIST^BPSOSL($TEXT(+0)_"-No TRANLIST passed into BPSOSCA")
End DoDot:1
QUIT "306^No TRANLIST defined"
+4 ;
+5 ; Manage local variables
+6 NEW BPS,START,END,TOTAL,NCLAIMS,CLAIMN,ERROR
+7 SET ERROR=$$BPS^BPSOSCB()
+8 IF ERROR
DO LOG2LIST^BPSOSL($TEXT(+0)_"-$$BPS^BPSOSCB(.BPS) returned "_ERROR)
+9 IF $GET(BPS("RX",0))=""
if 'ERROR
SET ERROR="301^BPS(""RX"" not created"
QUIT ERROR
+10 IF $GET(BPS("NCPDP","# Meds/Claim"))=""
QUIT "302^Number of Meds not returned"
+11 ;
+12 ; Calculate number of claim records to be generated for Billing Item
+13 SET NCLAIMS=((BPS("RX",0)-1)\BPS("NCPDP","# Meds/Claim"))+1
+14 IF NCLAIMS=0
QUIT "303^Number of claims is zero"
+15 ;
+16 ;Generate claim submission records
+17 FOR CLAIMN=1:1:NCLAIMS
Begin DoDot:1
+18 SET START=((CLAIMN-1)*BPS("NCPDP","# Meds/Claim"))+1
+19 SET END=START+BPS("NCPDP","# Meds/Claim")-1
+20 if END>BPS("RX",0)
SET END=BPS("RX",0)
+21 SET TOTAL=END-START+1
+22 SET ERROR=$$NEWCLAIM^BPSOSCE(START,END,TOTAL)
+23 IF ERROR]""
QUIT
+24 SET CLAIMIEN=BPS(9002313.02)
+25 SET CLAIMIEN(CLAIMIEN)=""
+26 ; Mark each of the .59s with the claim number and position within
+27 FOR I=START:1:END
Begin DoDot:2
+28 ;
+29 ; IEN59 handling 06/23/2000. The ELSE should never happen again.
+30 ; and the $G() can probably be gotten rid of, safely.
+31 NEW IEN59
SET IEN59=$GET(BPS("RX",I,"IEN59"))
+32 IF IEN59
Begin DoDot:3
+33 NEW DIE,DA,DR
SET DIE=9002313.59
+34 ;
+35 ; Field #3-CLAIM, #14-POSITION
+36 ; POSITION: Not the relative position within the packet,
+37 ; but the index in BPS("RX",n,.... This is the position in which
+38 ; it will be stored in ^BPSC(ien,400,POSITION
+39 ; and likewise for 9002313.03 when the response comes in.
+40 SET DA=IEN59
SET DR=3_"////"_CLAIMIEN_";14////"_I
NEW I
DO ^DIE
End DoDot:3
+41 IF '$TEST
Begin DoDot:3
+42 SET $PIECE(^BPST(BPS("RX",I,"RX IEN"),0),"^",4)=CLAIMIEN
+43 SET ^BPST("AE",CLAIMIEN,BPS("RX",I,"RX IEN"))=""
+44 SET $PIECE(^BPST(BPS("RX",I,"RX IEN"),0),"^",9)=I
End DoDot:3
End DoDot:2
End DoDot:1
if $GET(ERROR)
QUIT
+45 QUIT ERROR
