BPSECMC2 ;BHAM ISC/SAB - ENTER/EDIT OUTPATIENT SITE PARAMETERS ;09/18/92 9:11
;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,11**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; CHOP - Final processing prio to submitting a claim to HL7;
; Input
; HLA - HL7 packet (local array)
; CLAIMIEN - BPS Claims
; IEN59 - BPS Transactions
CHOP(HLA,CLAIMIEN,IEN59) ;
;
N TCNT,CNT,RNLNGTH,TRANID,V2DTG,RTN,MSG,BPSRESLT
S CNT=0,RTN=$T(+0)
;
; Crash proofing - Need to put better error handling in
I '$D(HLA)!'$L($G(CLAIMIEN)) D ERROR^BPSOSU(RTN,IEN59,511,"Invalid Claim Data") Q
;
; Determine run length of the transmission & pad with zeroes
S RNLNGTH=0
F TCNT=1:1 Q:$G(HLA("HLS",TCNT))="" S RNLNGTH=RNLNGTH+$L(HLA("HLS",TCNT))
S RNLNGTH=$RE($E($RE("0000"_(RNLNGTH+32)),1,4))
S CNT=TCNT-1
;
S TRANID=$P($G(^BPSC(CLAIMIEN,0)),"^")
S HLA("HLS",1)="\X02\"_RNLNGTH_TRANID_$G(HLA("HLS",1))
;
; Translate non-printable to printable & Set OBX segs
F TCNT=1:1:CNT Q:$G(HLA("HLS",TCNT))="" D
. F D Q:$P(HLA("HLS",TCNT),$C(29))=HLA("HLS",TCNT)
.. S:HLA("HLS",TCNT)[$C(29) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(29))_"\X1D\"_$P(HLA("HLS",TCNT),$C(29),2,999)
. F D Q:$P(HLA("HLS",TCNT),$C(30))=HLA("HLS",TCNT)
.. S:HLA("HLS",TCNT)[$C(30) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(30))_"\X1E\"_$P(HLA("HLS",TCNT),$C(30),2,999)
. F D Q:$P(HLA("HLS",TCNT),$C(28))=HLA("HLS",TCNT)
.. S:HLA("HLS",TCNT)[$C(28) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(28))_"\X1C\"_$P(HLA("HLS",TCNT),$C(28),2,999)
. I TCNT=CNT S HLA("HLS",CNT)=$P(HLA("HLS",CNT),$C(3))_"\X03\"
. S HLA("HLS",TCNT)="OBX||FT|NCPDP|"_TCNT_"|"_HLA("HLS",TCNT)_"||||||F"
;
; Set OBR seg
; Get fileman date/time, ensuring seconds are included: 3031029.135636
S V2DTG=$E($$HTFM^XLFDT($H)_"000000",1,14)
;
; Set HL7 Date/Time format: 20031029135636-0400
S HLA("HLS",.5)="OBR||||NCPDP|||"_$$FMTHL7^XLFDT(V2DTG)_"|||||||||||"_$E(TRANID,1,32)
K HLA("HLS",0)
;
; Change status to 60 and call HL7 to transmit a single message
D SETSTAT^BPSOSU(IEN59,60)
D GENERATE^HLMA("BPS ECMESV1 NTE","LM",1,.BPSRESLT,"")
S BPSRESLT=$G(BPSRESLT)
D LOG^BPSOSL(IEN59,RTN_"-HL7 Return Value. BPSRESLT: "_BPSRESLT)
S $P(^BPST(IEN59,0),U,3)=$P(BPSRESLT,U)
;
; If error, log error and quit
I +$P(BPSRESLT,U,2)>0 D Q
. S MSG="HL7 returned an error for "_$P($G(^BPSC(CLAIMIEN,0)),U)_". Error code: "_+$P(BPSRESLT,U,2)_". Error message: "_$P(BPSRESLT,U,3)
. D ERROR^BPSOSU(RTN,IEN59,601,MSG)
;
; If successful, log message
; Needed for Turn-Around Stats - Do NOT delete/alter!!
D LOG^BPSOSL(IEN59,RTN_"-Claim Sent - "_$P($G(^BPSC(CLAIMIEN,0)),U))
;
; Update Transmitted On field in BPS Claim
N FDA,MSG
S FDA(9002313.02,CLAIMIEN_",",.05)=$$NOW^XLFDT
D FILE^DIE("","FDA","MSG")
;
; If filing did not work, log it
I $D(MSG) D LOG^BPSOSL(IEN59,$T(+0)_"-Failed to update Transmitted On field")
Q
;
; STORESP - The HL7 Response Processing Routine calls this procedure. This module reads the
; the information and stores it into BPS Responses
; Note the code below assumes that there will only be one Claim per Transaction.
; If the VA ever bundles multiple transactions into a single claim, the code
; below will need to be change to walk the AE/AER index to handle each transaction
;
; HLNODE and HLNEXT are 'passed-in' by the HL7 application
STORESP ;
;
; Initialize variables
N RI,TMSG,RMSG,RESPIEN,TRANTYPE,VANUM,CLAIMIEN,IEN59
;
; Get the OBX segment
S TMSG=""
F RI=1:1 X HLNEXT Q:HLNODE="" I $E(HLNODE,1,3)="OBX" D
. S TMSG=HLNODE,RMSG=""
. F S RMSG=$O(HLNODE(RMSG)) Q:RMSG="" S TMSG=TMSG_HLNODE(RMSG)
;
; Strip off HL7, STX, ETX, NTE, and Byte Count
S TMSG=$P(TMSG,$E(TMSG,4),6),TMSG=$E(TMSG,10,$L(TMSG)-5)
;
; Get the claim ID (external and internal)
S TRANTYPE=$E(TMSG,35,36),VANUM=$E(TMSG,1,32)
S CLAIMIEN=$O(^BPSC("B",VANUM,""))
;
; Using the Claim ID, get the BPS transaction IEN
; If CLAIMIEN is null, next line will crash ungracefully
; We should log an error, but we need the Transaction IEN to
; do so. So, the next best thing is to log an error in the error
; trap.
S IEN59=$O(^BPST("AE",CLAIMIEN,""))
I IEN59="" S IEN59=$O(^BPST("AER",CLAIMIEN,""))
;
; Update the status to 70 (Receiving Response)
D SETSTAT^BPSOSU(IEN59,70)
;
; Store the response in BPS Response
D LOG^BPSOSL(IEN59,$T(+0)_"-Parsing Response "_$P($G(^BPSC(CLAIMIEN,0)),U))
;
; Parse the response and store it into BPS Responses
S RESPIEN=$$PARSE^BPSECMPS(TMSG,CLAIMIEN,IEN59,TRANTYPE)
;
; Log that parsing is done
; Needed for Turn-Around Stats - Do NOT delete/alter!!
D LOG^BPSOSL(IEN59,$T(+0)_"-Response stored "_$P($G(^BPSC(CLAIMIEN,0)),U))
;
; Call BPSOSQL for final processing
D ONE^BPSOSQL(CLAIMIEN,RESPIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSECMC2 4897 printed Apr 09, 2024@20:57:56 Page 2
BPSECMC2 ;BHAM ISC/SAB - ENTER/EDIT OUTPATIENT SITE PARAMETERS ;09/18/92 9:11
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,11**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; CHOP - Final processing prio to submitting a claim to HL7;
+5 ; Input
+6 ; HLA - HL7 packet (local array)
+7 ; CLAIMIEN - BPS Claims
+8 ; IEN59 - BPS Transactions
CHOP(HLA,CLAIMIEN,IEN59) ;
+1 ;
+2 NEW TCNT,CNT,RNLNGTH,TRANID,V2DTG,RTN,MSG,BPSRESLT
+3 SET CNT=0
SET RTN=$TEXT(+0)
+4 ;
+5 ; Crash proofing - Need to put better error handling in
+6 IF '$DATA(HLA)!'$LENGTH($GET(CLAIMIEN))
DO ERROR^BPSOSU(RTN,IEN59,511,"Invalid Claim Data")
QUIT
+7 ;
+8 ; Determine run length of the transmission & pad with zeroes
+9 SET RNLNGTH=0
+10 FOR TCNT=1:1
if $GET(HLA("HLS",TCNT))=""
QUIT
SET RNLNGTH=RNLNGTH+$LENGTH(HLA("HLS",TCNT))
+11 SET RNLNGTH=$REVERSE($EXTRACT($REVERSE("0000"_(RNLNGTH+32)),1,4))
+12 SET CNT=TCNT-1
+13 ;
+14 SET TRANID=$PIECE($GET(^BPSC(CLAIMIEN,0)),"^")
+15 SET HLA("HLS",1)="\X02\"_RNLNGTH_TRANID_$GET(HLA("HLS",1))
+16 ;
+17 ; Translate non-printable to printable & Set OBX segs
+18 FOR TCNT=1:1:CNT
if $GET(HLA("HLS",TCNT))=""
QUIT
Begin DoDot:1
+19 FOR
Begin DoDot:2
+20 if HLA("HLS",TCNT)[$CHAR(29)
SET HLA("HLS",TCNT)=$PIECE(HLA("HLS",TCNT),$CHAR(29))_"\X1D\"_$PIECE(HLA("HLS",TCNT),$CHAR(29),2,999)
End DoDot:2
if $PIECE(HLA("HLS",TCNT),$CHAR(29))=HLA("HLS",TCNT)
QUIT
+21 FOR
Begin DoDot:2
+22 if HLA("HLS",TCNT)[$CHAR(30)
SET HLA("HLS",TCNT)=$PIECE(HLA("HLS",TCNT),$CHAR(30))_"\X1E\"_$PIECE(HLA("HLS",TCNT),$CHAR(30),2,999)
End DoDot:2
if $PIECE(HLA("HLS",TCNT),$CHAR(30))=HLA("HLS",TCNT)
QUIT
+23 FOR
Begin DoDot:2
+24 if HLA("HLS",TCNT)[$CHAR(28)
SET HLA("HLS",TCNT)=$PIECE(HLA("HLS",TCNT),$CHAR(28))_"\X1C\"_$PIECE(HLA("HLS",TCNT),$CHAR(28),2,999)
End DoDot:2
if $PIECE(HLA("HLS",TCNT),$CHAR(28))=HLA("HLS",TCNT)
QUIT
+25 IF TCNT=CNT
SET HLA("HLS",CNT)=$PIECE(HLA("HLS",CNT),$CHAR(3))_"\X03\"
+26 SET HLA("HLS",TCNT)="OBX||FT|NCPDP|"_TCNT_"|"_HLA("HLS",TCNT)_"||||||F"
End DoDot:1
+27 ;
+28 ; Set OBR seg
+29 ; Get fileman date/time, ensuring seconds are included: 3031029.135636
+30 SET V2DTG=$EXTRACT($$HTFM^XLFDT($HOROLOG)_"000000",1,14)
+31 ;
+32 ; Set HL7 Date/Time format: 20031029135636-0400
+33 SET HLA("HLS",.5)="OBR||||NCPDP|||"_$$FMTHL7^XLFDT(V2DTG)_"|||||||||||"_$EXTRACT(TRANID,1,32)
+34 KILL HLA("HLS",0)
+35 ;
+36 ; Change status to 60 and call HL7 to transmit a single message
+37 DO SETSTAT^BPSOSU(IEN59,60)
+38 DO GENERATE^HLMA("BPS ECMESV1 NTE","LM",1,.BPSRESLT,"")
+39 SET BPSRESLT=$GET(BPSRESLT)
+40 DO LOG^BPSOSL(IEN59,RTN_"-HL7 Return Value. BPSRESLT: "_BPSRESLT)
+41 SET $PIECE(^BPST(IEN59,0),U,3)=$PIECE(BPSRESLT,U)
+42 ;
+43 ; If error, log error and quit
+44 IF +$PIECE(BPSRESLT,U,2)>0
Begin DoDot:1
+45 SET MSG="HL7 returned an error for "_$PIECE($GET(^BPSC(CLAIMIEN,0)),U)_". Error code: "_+$PIECE(BPSRESLT,U,2)_". Error message: "_$PIECE(BPSRESLT,U,3)
+46 DO ERROR^BPSOSU(RTN,IEN59,601,MSG)
End DoDot:1
QUIT
+47 ;
+48 ; If successful, log message
+49 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
+50 DO LOG^BPSOSL(IEN59,RTN_"-Claim Sent - "_$PIECE($GET(^BPSC(CLAIMIEN,0)),U))
+51 ;
+52 ; Update Transmitted On field in BPS Claim
+53 NEW FDA,MSG
+54 SET FDA(9002313.02,CLAIMIEN_",",.05)=$$NOW^XLFDT
+55 DO FILE^DIE("","FDA","MSG")
+56 ;
+57 ; If filing did not work, log it
+58 IF $DATA(MSG)
DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Failed to update Transmitted On field")
+59 QUIT
+60 ;
+61 ; STORESP - The HL7 Response Processing Routine calls this procedure. This module reads the
+62 ; the information and stores it into BPS Responses
+63 ; Note the code below assumes that there will only be one Claim per Transaction.
+64 ; If the VA ever bundles multiple transactions into a single claim, the code
+65 ; below will need to be change to walk the AE/AER index to handle each transaction
+66 ;
+67 ; HLNODE and HLNEXT are 'passed-in' by the HL7 application
STORESP ;
+1 ;
+2 ; Initialize variables
+3 NEW RI,TMSG,RMSG,RESPIEN,TRANTYPE,VANUM,CLAIMIEN,IEN59
+4 ;
+5 ; Get the OBX segment
+6 SET TMSG=""
+7 FOR RI=1:1
XECUTE HLNEXT
if HLNODE=""
QUIT
IF $EXTRACT(HLNODE,1,3)="OBX"
Begin DoDot:1
+8 SET TMSG=HLNODE
SET RMSG=""
+9 FOR
SET RMSG=$ORDER(HLNODE(RMSG))
if RMSG=""
QUIT
SET TMSG=TMSG_HLNODE(RMSG)
End DoDot:1
+10 ;
+11 ; Strip off HL7, STX, ETX, NTE, and Byte Count
+12 SET TMSG=$PIECE(TMSG,$EXTRACT(TMSG,4),6)
SET TMSG=$EXTRACT(TMSG,10,$LENGTH(TMSG)-5)
+13 ;
+14 ; Get the claim ID (external and internal)
+15 SET TRANTYPE=$EXTRACT(TMSG,35,36)
SET VANUM=$EXTRACT(TMSG,1,32)
+16 SET CLAIMIEN=$ORDER(^BPSC("B",VANUM,""))
+17 ;
+18 ; Using the Claim ID, get the BPS transaction IEN
+19 ; If CLAIMIEN is null, next line will crash ungracefully
+20 ; We should log an error, but we need the Transaction IEN to
+21 ; do so. So, the next best thing is to log an error in the error
+22 ; trap.
+23 SET IEN59=$ORDER(^BPST("AE",CLAIMIEN,""))
+24 IF IEN59=""
SET IEN59=$ORDER(^BPST("AER",CLAIMIEN,""))
+25 ;
+26 ; Update the status to 70 (Receiving Response)
+27 DO SETSTAT^BPSOSU(IEN59,70)
+28 ;
+29 ; Store the response in BPS Response
+30 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Parsing Response "_$PIECE($GET(^BPSC(CLAIMIEN,0)),U))
+31 ;
+32 ; Parse the response and store it into BPS Responses
+33 SET RESPIEN=$$PARSE^BPSECMPS(TMSG,CLAIMIEN,IEN59,TRANTYPE)
+34 ;
+35 ; Log that parsing is done
+36 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
+37 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Response stored "_$PIECE($GET(^BPSC(CLAIMIEN,0)),U))
+38 ;
+39 ; Call BPSOSQL for final processing
+40 DO ONE^BPSOSQL(CLAIMIEN,RESPIEN)
+41 QUIT
