Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSECMC2

BPSECMC2.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; CHOP - Final processing prio to submitting a claim to HL7;
  1.  ; Input
  1.  ;   HLA      - HL7 packet (local array)
  1.  ;   CLAIMIEN - BPS Claims
  1.  ;   IEN59    - BPS Transactions
  1. CHOP(HLA,CLAIMIEN,IEN59) ;
  1.  ;
  1.  N TCNT,CNT,RNLNGTH,TRANID,V2DTG,RTN,MSG,BPSRESLT
  1.  S CNT=0,RTN=$T(+0)
  1.  ;
  1.  ; Crash proofing - Need to put better error handling in
  1.  I '$D(HLA)!'$L($G(CLAIMIEN)) D ERROR^BPSOSU(RTN,IEN59,511,"Invalid Claim Data") Q
  1.  ;
  1.  ; Determine run length of the transmission & pad with zeroes
  1.  S RNLNGTH=0
  1.  F TCNT=1:1 Q:$G(HLA("HLS",TCNT))=""  S RNLNGTH=RNLNGTH+$L(HLA("HLS",TCNT))
  1.  S RNLNGTH=$RE($E($RE("0000"_(RNLNGTH+32)),1,4))
  1.  S CNT=TCNT-1
  1.  ;
  1.  S TRANID=$P($G(^BPSC(CLAIMIEN,0)),"^")
  1.  S HLA("HLS",1)="\X02\"_RNLNGTH_TRANID_$G(HLA("HLS",1))
  1.  ;
  1.  ; Translate non-printable to printable & Set OBX segs
  1.  F TCNT=1:1:CNT Q:$G(HLA("HLS",TCNT))=""  D
  1.  . F  D  Q:$P(HLA("HLS",TCNT),$C(29))=HLA("HLS",TCNT)
  1.  .. S:HLA("HLS",TCNT)[$C(29) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(29))_"\X1D\"_$P(HLA("HLS",TCNT),$C(29),2,999)
  1.  . F  D  Q:$P(HLA("HLS",TCNT),$C(30))=HLA("HLS",TCNT)
  1.  .. S:HLA("HLS",TCNT)[$C(30) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(30))_"\X1E\"_$P(HLA("HLS",TCNT),$C(30),2,999)
  1.  . F  D  Q:$P(HLA("HLS",TCNT),$C(28))=HLA("HLS",TCNT)
  1.  .. S:HLA("HLS",TCNT)[$C(28) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(28))_"\X1C\"_$P(HLA("HLS",TCNT),$C(28),2,999)
  1.  . I TCNT=CNT S HLA("HLS",CNT)=$P(HLA("HLS",CNT),$C(3))_"\X03\"
  1.  . S HLA("HLS",TCNT)="OBX||FT|NCPDP|"_TCNT_"|"_HLA("HLS",TCNT)_"||||||F"
  1.  ;
  1.  ; Set OBR seg
  1.  ; Get fileman date/time, ensuring seconds are included: 3031029.135636
  1.  S V2DTG=$E($$HTFM^XLFDT($H)_"000000",1,14)
  1.  ;
  1.  ; Set HL7 Date/Time format: 20031029135636-0400
  1.  S HLA("HLS",.5)="OBR||||NCPDP|||"_$$FMTHL7^XLFDT(V2DTG)_"|||||||||||"_$E(TRANID,1,32)
  1.  K HLA("HLS",0)
  1.  ;
  1.  ; Change status to 60 and call HL7 to transmit a single message
  1.  D SETSTAT^BPSOSU(IEN59,60)
  1.  D GENERATE^HLMA("BPS ECMESV1 NTE","LM",1,.BPSRESLT,"")
  1.  S BPSRESLT=$G(BPSRESLT)
  1.  D LOG^BPSOSL(IEN59,RTN_"-HL7 Return Value.  BPSRESLT: "_BPSRESLT)
  1.  S $P(^BPST(IEN59,0),U,3)=$P(BPSRESLT,U)
  1.  ;
  1.  ; If error, log error and quit
  1.  I +$P(BPSRESLT,U,2)>0 D  Q
  1.  . 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)
  1.  . D ERROR^BPSOSU(RTN,IEN59,601,MSG)
  1.  ;
  1.  ; If successful, log message
  1.  ; Needed for Turn-Around Stats - Do NOT delete/alter!!
  1.  D LOG^BPSOSL(IEN59,RTN_"-Claim Sent - "_$P($G(^BPSC(CLAIMIEN,0)),U))
  1.  ;
  1.  ; Update Transmitted On field in BPS Claim
  1.  N FDA,MSG
  1.  S FDA(9002313.02,CLAIMIEN_",",.05)=$$NOW^XLFDT
  1.  D FILE^DIE("","FDA","MSG")
  1.  ;
  1.  ; If filing did not work, log it
  1.  I $D(MSG) D LOG^BPSOSL(IEN59,$T(+0)_"-Failed to update Transmitted On field")
  1.  Q
  1.  ;
  1.  ; STORESP - The HL7 Response Processing Routine calls this procedure.  This module reads the
  1.  ;   the information and stores it into BPS Responses
  1.  ;   Note the code below assumes that there will only be one Claim per Transaction.
  1.  ;   If the VA ever bundles multiple transactions into a single claim, the code
  1.  ;   below will need to be change to walk the AE/AER index to handle each transaction
  1.  ;
  1.  ; HLNODE and HLNEXT are 'passed-in' by the HL7 application
  1. STORESP ;
  1.  ;
  1.  ; Initialize variables
  1.  N RI,TMSG,RMSG,RESPIEN,TRANTYPE,VANUM,CLAIMIEN,IEN59
  1.  ;
  1.  ; Get the OBX segment
  1.  S TMSG=""
  1.  F RI=1:1 X HLNEXT Q:HLNODE=""  I $E(HLNODE,1,3)="OBX"  D
  1.  . S TMSG=HLNODE,RMSG=""
  1.  . F  S RMSG=$O(HLNODE(RMSG)) Q:RMSG=""  S TMSG=TMSG_HLNODE(RMSG)
  1.  ;
  1.  ; Strip off HL7, STX, ETX, NTE, and Byte Count
  1.  S TMSG=$P(TMSG,$E(TMSG,4),6),TMSG=$E(TMSG,10,$L(TMSG)-5)
  1.  ;
  1.  ; Get the claim ID (external and internal)
  1.  S TRANTYPE=$E(TMSG,35,36),VANUM=$E(TMSG,1,32)
  1.  S CLAIMIEN=$O(^BPSC("B",VANUM,""))
  1.  ;
  1.  ; Using the Claim ID, get the BPS transaction IEN
  1.  ;   If CLAIMIEN is null, next line will crash ungracefully
  1.  ;   We should log an error, but we need the Transaction IEN to
  1.  ;   do so.  So, the next best thing is to log an error in the error
  1.  ;   trap.
  1.  S IEN59=$O(^BPST("AE",CLAIMIEN,""))
  1.  I IEN59="" S IEN59=$O(^BPST("AER",CLAIMIEN,""))
  1.  ;
  1.  ; Update the status to 70 (Receiving Response)
  1.  D SETSTAT^BPSOSU(IEN59,70)
  1.  ;
  1.  ; Store the response in BPS Response
  1.  D LOG^BPSOSL(IEN59,$T(+0)_"-Parsing Response "_$P($G(^BPSC(CLAIMIEN,0)),U))
  1.  ;
  1.  ; Parse the response and store it into BPS Responses
  1.  S RESPIEN=$$PARSE^BPSECMPS(TMSG,CLAIMIEN,IEN59,TRANTYPE)
  1.  ;
  1.  ; Log that parsing is done
  1.  ; Needed for Turn-Around Stats - Do NOT delete/alter!!
  1.  D LOG^BPSOSL(IEN59,$T(+0)_"-Response stored "_$P($G(^BPSC(CLAIMIEN,0)),U))
  1.  ;
  1.  ; Call BPSOSQL for final processing
  1.  D ONE^BPSOSQL(CLAIMIEN,RESPIEN)
  1.  Q