BPSOSQG ;BHAM ISC/FCS/DRS/FLS - form transmission packets ;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
;
; PACKET
; Calls BPSOSCA to get claims data (BPS array)
; Calls BPSECA1 to create packet
; Calls CHOP^BPSECMC2 to send packet to HL7 application
;
PACKET() ;EP - BPSOSQ2
; packetize one transaction (and possibly more transactions
; for the same patient, if they're ready now.)
; Called from BPSOSQ2,
; which gave us TRANLIST(IEN59) array of claims to packetize.
;
N CLAIMIEN,ERROR,FIRST59
;
; Get first transaction from list
S FIRST59=$O(TRANLIST(0))
;
; If it's a reversal, we already have an ^BPSC(, which was
; created by the call to BPSECA8, way back at the beginning.
; So, unlike claims, we need only the NCPDP formatting for it
; by creating CLAIMIEN array and jumping to POINTM
I $G(^BPST(FIRST59,4)) D G POINTM
. ; Mimic a few things that are set up in the code we're skipping
. S CLAIMIEN=$P(^BPST(FIRST59,4),U)
. S CLAIMIEN(CLAIMIEN)=""
;
; DMB - This code will only be executed if there is more than one
; transaction in TRANLIST. This will not happen for the VA but leave
; functionality in case we bundle claims later
I $O(TRANLIST($O(TRANLIST("")))) D
. D LOG2LIST^BPSOSL($T(+0)_"-Packetizing - we have more than one claim:")
. N I,X,Y S (X,Y)=""
. F I=1:1 S X=$O(TRANLIST(X)) Q:'X D
. . S $P(Y,", ",I-1#4+1)=X
. . I I#4=0 D LOG2LIST^BPSOSL(Y) S Y=""
. I Y]"" D LOG2LIST^BPSOSL(Y)
;
; BPSOSCA calls BPSOSCB,BPSOSCC,BPSOSCD to set up BPS(*) and
; then calls BPSOSCE to create claims in 9002313.02
; BPSOSCA expects TRANLIST(*) to be defined and will return
; ERROR - any error encountered
; CLAIMIEN - last claim created
; CLAIMIEN(CLAIMIEN) - the list of all claims created
S ERROR=$$EN^BPSOSCA(.CLAIMIEN)
I ERROR D LOG2LIST^BPSOSL($T(+0)_"-ERROR="_ERROR_" returned from BPSOSCA")
I $G(CLAIMIEN)<1 Q $S(ERROR:ERROR,1:"300^No Claim IEN returned by BPSOSCA")
;
; POINTM will create the claims packet and put them in XTMP
POINTM ; Reversals are joining again here
N VAMSG,IEN59,ERROR
;
; CLAIMIEN(*) = a list of CLAIMIENs that were generated from
; all the transactions that might have been bundled together.
; So we must loop through that list.
; Currently, VA does not bundle claims. If it does so,
; we may want to change error handling.
S ERROR=0,CLAIMIEN=""
F S CLAIMIEN=$O(CLAIMIEN(CLAIMIEN)) Q:CLAIMIEN="" D
. S IEN59=$O(^BPST("AE",CLAIMIEN,""))
. I IEN59="" S IEN59=$O(^BPST("AER",CLAIMIEN,""))
. I IEN59="" S ERROR="500^Transaction IEN not determined for "_CLAIMIEN Q
. D SETSTAT^BPSOSU(IEN59,50)
. K VAMSG
. D LOG2CLM^BPSOSL(CLAIMIEN,$T(+0)_"-Packet being built for Claim ID "_$P(^BPSC(CLAIMIEN,0),U))
. D ASCII^BPSECA1(CLAIMIEN,.VAMSG)
. I '$G(VAMSG("HLS",0)) S ERROR="501^Claim packet not built for "_$P($G(^BPSC(CLAIMIEN,0)),U,1) Q
. D CHOP^BPSECMC2(.VAMSG,CLAIMIEN,IEN59)
Q ERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSQG 3078 printed Nov 22, 2024@17:02:08 Page 2
BPSOSQG ;BHAM ISC/FCS/DRS/FLS - form transmission packets ;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 QUIT
+4 ;
+5 ; PACKET
+6 ; Calls BPSOSCA to get claims data (BPS array)
+7 ; Calls BPSECA1 to create packet
+8 ; Calls CHOP^BPSECMC2 to send packet to HL7 application
+9 ;
PACKET() ;EP - BPSOSQ2
+1 ; packetize one transaction (and possibly more transactions
+2 ; for the same patient, if they're ready now.)
+3 ; Called from BPSOSQ2,
+4 ; which gave us TRANLIST(IEN59) array of claims to packetize.
+5 ;
+6 NEW CLAIMIEN,ERROR,FIRST59
+7 ;
+8 ; Get first transaction from list
+9 SET FIRST59=$ORDER(TRANLIST(0))
+10 ;
+11 ; If it's a reversal, we already have an ^BPSC(, which was
+12 ; created by the call to BPSECA8, way back at the beginning.
+13 ; So, unlike claims, we need only the NCPDP formatting for it
+14 ; by creating CLAIMIEN array and jumping to POINTM
+15 IF $GET(^BPST(FIRST59,4))
Begin DoDot:1
+16 ; Mimic a few things that are set up in the code we're skipping
+17 SET CLAIMIEN=$PIECE(^BPST(FIRST59,4),U)
+18 SET CLAIMIEN(CLAIMIEN)=""
End DoDot:1
GOTO POINTM
+19 ;
+20 ; DMB - This code will only be executed if there is more than one
+21 ; transaction in TRANLIST. This will not happen for the VA but leave
+22 ; functionality in case we bundle claims later
+23 IF $ORDER(TRANLIST($ORDER(TRANLIST(""))))
Begin DoDot:1
+24 DO LOG2LIST^BPSOSL($TEXT(+0)_"-Packetizing - we have more than one claim:")
+25 NEW I,X,Y
SET (X,Y)=""
+26 FOR I=1:1
SET X=$ORDER(TRANLIST(X))
if 'X
QUIT
Begin DoDot:2
+27 SET $PIECE(Y,", ",I-1#4+1)=X
+28 IF I#4=0
DO LOG2LIST^BPSOSL(Y)
SET Y=""
End DoDot:2
+29 IF Y]""
DO LOG2LIST^BPSOSL(Y)
End DoDot:1
+30 ;
+31 ; BPSOSCA calls BPSOSCB,BPSOSCC,BPSOSCD to set up BPS(*) and
+32 ; then calls BPSOSCE to create claims in 9002313.02
+33 ; BPSOSCA expects TRANLIST(*) to be defined and will return
+34 ; ERROR - any error encountered
+35 ; CLAIMIEN - last claim created
+36 ; CLAIMIEN(CLAIMIEN) - the list of all claims created
+37 SET ERROR=$$EN^BPSOSCA(.CLAIMIEN)
+38 IF ERROR
DO LOG2LIST^BPSOSL($TEXT(+0)_"-ERROR="_ERROR_" returned from BPSOSCA")
+39 IF $GET(CLAIMIEN)<1
QUIT $SELECT(ERROR:ERROR,1:"300^No Claim IEN returned by BPSOSCA")
+40 ;
+41 ; POINTM will create the claims packet and put them in XTMP
POINTM ; Reversals are joining again here
+1 NEW VAMSG,IEN59,ERROR
+2 ;
+3 ; CLAIMIEN(*) = a list of CLAIMIENs that were generated from
+4 ; all the transactions that might have been bundled together.
+5 ; So we must loop through that list.
+6 ; Currently, VA does not bundle claims. If it does so,
+7 ; we may want to change error handling.
+8 SET ERROR=0
SET CLAIMIEN=""
+9 FOR
SET CLAIMIEN=$ORDER(CLAIMIEN(CLAIMIEN))
if CLAIMIEN=""
QUIT
Begin DoDot:1
+10 SET IEN59=$ORDER(^BPST("AE",CLAIMIEN,""))
+11 IF IEN59=""
SET IEN59=$ORDER(^BPST("AER",CLAIMIEN,""))
+12 IF IEN59=""
SET ERROR="500^Transaction IEN not determined for "_CLAIMIEN
QUIT
+13 DO SETSTAT^BPSOSU(IEN59,50)
+14 KILL VAMSG
+15 DO LOG2CLM^BPSOSL(CLAIMIEN,$TEXT(+0)_"-Packet being built for Claim ID "_$PIECE(^BPSC(CLAIMIEN,0),U))
+16 DO ASCII^BPSECA1(CLAIMIEN,.VAMSG)
+17 IF '$GET(VAMSG("HLS",0))
SET ERROR="501^Claim packet not built for "_$PIECE($GET(^BPSC(CLAIMIEN,0)),U,1)
QUIT
+18 DO CHOP^BPSECMC2(.VAMSG,CLAIMIEN,IEN59)
End DoDot:1
+19 QUIT ERROR
