1 | BPSECMC2 ;BHAM ISC/SAB - ENTER/EDIT OUTPATIENT SITE PARAMETERS ;09/18/92 9:11
|
---|
2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
|
---|
3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; CHOP - Final processing prio to submitting a claim to HL7;
|
---|
6 | ; Input
|
---|
7 | ; HLA - HL7 packet (local array)
|
---|
8 | ; CLAIMIEN - BPS Claims
|
---|
9 | ; IEN59 - BPS Transactions
|
---|
10 | CHOP(HLA,CLAIMIEN,IEN59) ;
|
---|
11 | ;
|
---|
12 | N TCNT,CNT,RNLNGTH,TRANID,V2DTG,RTN,MSG
|
---|
13 | N BPSRESLT,HL
|
---|
14 | S CNT=0,RTN=$T(+0)
|
---|
15 | ;
|
---|
16 | ; Crash proofing - Need to put better error handling in
|
---|
17 | I '$D(HLA)!'$L($G(CLAIMIEN)) D ERROR^BPSOSU(RTN,IEN59,511,"Invalid Claim Data") Q
|
---|
18 | ;
|
---|
19 | ; Initialize HL7 environment
|
---|
20 | D INIT^HLFNC2("BPS ECMECL1 NTE",.HL)
|
---|
21 | ;
|
---|
22 | ; Handle failure if variables were not initialized
|
---|
23 | I $G(HL) D ERROR^BPSOSU(RTN,IEN59,512,"Call to INIT^HLFNC2 failed") Q
|
---|
24 | ;
|
---|
25 | ; Determine run length of the transmission & pad with zeroes
|
---|
26 | S RNLNGTH=0
|
---|
27 | F TCNT=1:1 Q:$G(HLA("HLS",TCNT))="" S RNLNGTH=RNLNGTH+$L(HLA("HLS",TCNT))
|
---|
28 | S RNLNGTH=$RE($E($RE("0000"_(RNLNGTH+32)),1,4))
|
---|
29 | S CNT=TCNT-1
|
---|
30 | ;
|
---|
31 | S TRANID=$P($G(^BPSC(CLAIMIEN,0)),"^")
|
---|
32 | S HLA("HLS",1)="\X02\"_RNLNGTH_TRANID_$G(HLA("HLS",1))
|
---|
33 | ;
|
---|
34 | ; Translate non-printable to printable & Set OBX segs
|
---|
35 | F TCNT=1:1:CNT Q:$G(HLA("HLS",TCNT))="" D
|
---|
36 | . F D Q:$P(HLA("HLS",TCNT),$C(29))=HLA("HLS",TCNT)
|
---|
37 | .. S:HLA("HLS",TCNT)[$C(29) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(29))_"\X1D\"_$P(HLA("HLS",TCNT),$C(29),2,999)
|
---|
38 | . F D Q:$P(HLA("HLS",TCNT),$C(30))=HLA("HLS",TCNT)
|
---|
39 | .. S:HLA("HLS",TCNT)[$C(30) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(30))_"\X1E\"_$P(HLA("HLS",TCNT),$C(30),2,999)
|
---|
40 | . F D Q:$P(HLA("HLS",TCNT),$C(28))=HLA("HLS",TCNT)
|
---|
41 | .. S:HLA("HLS",TCNT)[$C(28) HLA("HLS",TCNT)=$P(HLA("HLS",TCNT),$C(28))_"\X1C\"_$P(HLA("HLS",TCNT),$C(28),2,999)
|
---|
42 | . I TCNT=CNT S HLA("HLS",CNT)=$P(HLA("HLS",CNT),$C(3))_"\X03\"
|
---|
43 | . S HLA("HLS",TCNT)="OBX||FT|NCPDP|"_TCNT_"|"_HLA("HLS",TCNT)_"||||||F"
|
---|
44 | ;
|
---|
45 | ; Set OBR seg
|
---|
46 | ; Get fileman date/time, ensuring seconds are included: 3031029.135636
|
---|
47 | S V2DTG=$E($$HTFM^XLFDT($H)_"000000",1,14)
|
---|
48 | ;
|
---|
49 | ; Set HL7 Date/Time format: 20031029135636-0400
|
---|
50 | S HLA("HLS",.5)="OBR||||NCPDP|||"_$$FMTHL7^XLFDT(V2DTG)_"|||||||||||"_$E(TRANID,1,32)
|
---|
51 | K HLA("HLS",0)
|
---|
52 | ;
|
---|
53 | ; Change status to 60 and call HL7 to transmit a single message
|
---|
54 | D SETSTAT^BPSOSU(IEN59,60)
|
---|
55 | D GENERATE^HLMA("BPS ECMESV1 NTE","LM",1,.BPSRESLT,"")
|
---|
56 | ;
|
---|
57 | ; If error, log error and quit
|
---|
58 | I +BPSRESLT'>0 D Q
|
---|
59 | . S MSG="HL7 error for "_$P($G(^BPSC(CLAIMIEN,0)),U)_". Error message-"_$P(BPSRESLT,U,3)_"-Error code: "_+$P(BPSRESLT,U,2)
|
---|
60 | . D ERROR^BPSOSU(RTN,IEN59,601,MSG)
|
---|
61 | ;
|
---|
62 | ; If successful, log message
|
---|
63 | ; Needed for Turn-Around Stats - Do NOT delete/alter!!
|
---|
64 | D LOG^BPSOSL(IEN59,RTN_"-Claim Sent - "_$P($G(^BPSC(CLAIMIEN,0)),U))
|
---|
65 | ;
|
---|
66 | ; Update Transmitted On field in BPS Claim
|
---|
67 | N FDA,MSG
|
---|
68 | S FDA(9002313.02,CLAIMIEN_",",.05)=$$NOW^XLFDT
|
---|
69 | D FILE^DIE("","FDA","MSG")
|
---|
70 | ;
|
---|
71 | ; If filing did not work, log it
|
---|
72 | I $D(MSG) D LOG^BPSOSL(IEN59,$T(+0)_"-Failed to update Transmitted On field")
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | ; STORESP - The HL7 Response Processing Routine calls this procedure. This module reads the
|
---|
76 | ; the information and stores it into BPS Responses
|
---|
77 | ; Note the code below assumes that there will only be one Claim per Transaction.
|
---|
78 | ; If the VA ever bundles multiple transactions into a single claim, the code
|
---|
79 | ; below will need to be change to walk the AE/AER index to handle each transaction
|
---|
80 | ;
|
---|
81 | ; HLNODE and HLNEXT are 'passed-in' by the HL7 application
|
---|
82 | STORESP ;
|
---|
83 | ;
|
---|
84 | ; Initialize variables
|
---|
85 | N RI,TMSG,RMSG,RESPIEN,TRANTYPE,VANUM,CLAIMIEN,IEN59
|
---|
86 | ;
|
---|
87 | ; Get the OBX segment
|
---|
88 | S TMSG=""
|
---|
89 | F RI=1:1 X HLNEXT Q:HLNODE="" I $E(HLNODE,1,3)="OBX" D
|
---|
90 | . S TMSG=HLNODE,RMSG=""
|
---|
91 | . F S RMSG=$O(HLNODE(RMSG)) Q:RMSG="" S TMSG=TMSG_HLNODE(RMSG)
|
---|
92 | ;
|
---|
93 | ; Strip off HL7, STX, ETX, NTE, and Byte Count
|
---|
94 | S TMSG=$P(TMSG,$E(TMSG,4),6),TMSG=$E(TMSG,10,$L(TMSG)-5)
|
---|
95 | ;
|
---|
96 | ; Get the claim ID (external and internal)
|
---|
97 | S TRANTYPE=$E(TMSG,35,36),VANUM=$E(TMSG,1,32)
|
---|
98 | S CLAIMIEN=$O(^BPSC("B",VANUM,""))
|
---|
99 | ;
|
---|
100 | ; Using the Claim ID, get the BPS transaction IEN
|
---|
101 | ; If CLAIMIEN is null, next line will crash ungracefully
|
---|
102 | ; We should log an error, but we need the Transaction IEN to
|
---|
103 | ; do so. So, the next best thing is to log an error in the error
|
---|
104 | ; trap.
|
---|
105 | S IEN59=$O(^BPST("AE",CLAIMIEN,""))
|
---|
106 | I IEN59="" S IEN59=$O(^BPST("AER",CLAIMIEN,""))
|
---|
107 | ;
|
---|
108 | ; Update the status to 70 (Receiving Response)
|
---|
109 | D SETSTAT^BPSOSU(IEN59,70)
|
---|
110 | ;
|
---|
111 | ; Store the response in BPS Response
|
---|
112 | D LOG^BPSOSL(IEN59,$T(+0)_"-Parsing Response "_$P($G(^BPSC(CLAIMIEN,0)),U))
|
---|
113 | ;
|
---|
114 | ; Parse the response and store it into BPS Responses
|
---|
115 | ; If the testing tool is on, BPSECMPS will need variable TRANTYPE as well
|
---|
116 | D PARSE^BPSECMPS(TMSG,CLAIMIEN,.RESPIEN)
|
---|
117 | ;
|
---|
118 | ; Log that parsing is done
|
---|
119 | ; Needed for Turn-Around Stats - Do NOT delete/alter!!
|
---|
120 | D LOG^BPSOSL(IEN59,$T(+0)_"-Response stored "_$P($G(^BPSC(CLAIMIEN,0)),U))
|
---|
121 | ;
|
---|
122 | ; Call BPSOSQL for final processing
|
---|
123 | D ONE^BPSOSQL(CLAIMIEN,$G(RESPIEN))
|
---|
124 | Q
|
---|