1 | BPSJAREG ;BHAM ISC/LJF - HL7 Application Registration MFN Message ;21-NOV-2003
|
---|
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 | ; This program will process the outgoing registration MFN message
|
---|
6 | ;
|
---|
7 | ; Variables
|
---|
8 | ; HL = HL7 parameters
|
---|
9 | ; HL7DTG = Date time in HL7 format
|
---|
10 | ; HLECH = HL7 Encoding Characters
|
---|
11 | ; HLEID = HL7 Link id
|
---|
12 | ; HLFS = HL7 Field separator
|
---|
13 | ; HLLNK = HL7 E-Pharm Link
|
---|
14 | ; HLRESET = HL7 generate results
|
---|
15 | ; IPP = IP Port
|
---|
16 | ; IPA = IP Address
|
---|
17 | ; MCT = Message Count
|
---|
18 | ; MGRP = E-Mail message group
|
---|
19 | ; MSG = Message
|
---|
20 | ;
|
---|
21 | INI ;
|
---|
22 | INIT ; Unconditional jump....
|
---|
23 | G ^BPSJINIT
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | BPSJVAL(BPSJVAL) ; Validation entry point - HL7 message processing prevented
|
---|
27 | ;
|
---|
28 | TASKMAN ; Entry point for taskman to run this routine
|
---|
29 | ;
|
---|
30 | N DA,HL,HL7DTG,HLECH,HLEID,HLFS,HLLNK,HLRESET,HLPRO
|
---|
31 | N IPA,IPP
|
---|
32 | N MGRP,MSG,MCT,BPSJARES,BPVALFN
|
---|
33 | ;
|
---|
34 | S MCT=0,BPSJVAL=+$G(BPSJVAL)
|
---|
35 | K ^TMP("HLS",$J)
|
---|
36 | ;
|
---|
37 | S BPVALFN=9002313.99
|
---|
38 | ;
|
---|
39 | ; Create/update BPS Setup record
|
---|
40 | ; Returns record number in DA
|
---|
41 | D VERSION^BPSJINIT(BPVALFN)
|
---|
42 | ;
|
---|
43 | ; The following code was copied from BPSJINIT w/o edits for patch BPS*1*2
|
---|
44 | ; It is probably not needed since VERSION^BPSJINIT sets the version
|
---|
45 | ; Need to delete/clean up in the next release
|
---|
46 | K DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
|
---|
47 | S DR=$P($G(^BPS(BPVALFN,DA,"VITRIA")),U,3)
|
---|
48 | I DR>2,DR=+DR
|
---|
49 | E S DIE=$$ROOT^DILFD(BPVALFN),DR="6003////3" D ^DIE
|
---|
50 | ;
|
---|
51 | ; Get Link data from HL7 table
|
---|
52 | S HLPRO="BPSJ REGISTER",(IPA,IPP)=""
|
---|
53 | S HLLNK=$$FIND1^DIC(870,"",,"EPHARM OUT","B")
|
---|
54 | I HLLNK S IPA=$$GET1^DIQ(870,HLLNK_",",400.01),IPP=$$GET1^DIQ(870,HLLNK_",",400.02)
|
---|
55 | ;
|
---|
56 | ; Error if any missing data
|
---|
57 | I IPA=""!(IPP="") S MCT=MCT+1,MSG(MCT)="IP Address or Port is not defined. "
|
---|
58 | ;
|
---|
59 | I MCT,'BPSJVAL D MSG^BPSJUTL(.MSG,"BPSJAREG") Q
|
---|
60 | ;
|
---|
61 | ; Initialize the HL7
|
---|
62 | D INIT^HLFNC2(HLPRO,.HL)
|
---|
63 | S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|"
|
---|
64 | S HLECH=$E($G(HL("ECH")),1) I HLECH="" S HLECH="^"
|
---|
65 | S HL("SITE")=$$SITE^VASITE,HL("SAF")=$P(HL("SITE"),U,2,3)
|
---|
66 | S HL("EPPORT")=IPP,HLEID=$$HLP^BPSJUTL(HLPRO)
|
---|
67 | ;
|
---|
68 | ;Get fileman date/time, ensuring seconds are included: 3031029.135636
|
---|
69 | S HL7DTG=$E($$HTFM^XLFDT($H)_"000000",1,14)
|
---|
70 | ;Set HL7 Date/Time format: 20031029135636-0400
|
---|
71 | S HL7DTG=$$FMTHL7^XLFDT(HL7DTG)
|
---|
72 | ;
|
---|
73 | ; Set the MFI segment
|
---|
74 | S ^TMP("HLS",$J,1)="MFI"_HLFS_"Facility Table"_HLFS_HLFS_"UPD"_HLFS
|
---|
75 | S ^TMP("HLS",$J,1)=^TMP("HLS",$J,1)_HL7DTG_HLFS_HL7DTG_HLFS_"NE"
|
---|
76 | ;
|
---|
77 | ; Set the MFE segment
|
---|
78 | S ^TMP("HLS",$J,2)="MFE"_HLFS_"MUP"_HLFS_HLFS_HL7DTG_HLFS
|
---|
79 | S ^TMP("HLS",$J,2)=^TMP("HLS",$J,2)_+HL("SITE")_HLFS_"ST"
|
---|
80 | ;
|
---|
81 | ; Set the ZQR segment
|
---|
82 | S ^TMP("HLS",$J,3)=$$EN^BPSJZQR(.HL)
|
---|
83 | ;
|
---|
84 | S BPSJARES=$$VAL1^BPSJVAL(BPSJVAL) ; 0 = ok,
|
---|
85 | I BPSJVAL=3 G FINI ; Just checking to see if data valid.
|
---|
86 | ;
|
---|
87 | ;-Check if msg valid.
|
---|
88 | I 'BPSJARES D G FINI
|
---|
89 | . N BPSHLRS
|
---|
90 | . D GENERATE^HLMA(HLEID,"GM",1,.BPSHLRS,"")
|
---|
91 | . I $P($G(BPSHLRS),U,2)]"" D Q
|
---|
92 | .. I BPSJVAL D Q ; Interactive: show no success
|
---|
93 | ... W !!,"ECME Application Registration HL7 Message not created: "_BPSHLRS
|
---|
94 | .. S MCT=MCT+1,MSG(MCT)="ECME Application Registration HL7 Message not created."
|
---|
95 | .. S MCT=MCT+1,MSG(MCT)=BPSHLRS
|
---|
96 | .. D MSG^BPSJUTL(.MSG,"ECME Application Registration")
|
---|
97 | . I BPSJVAL D ;Interactive: show success
|
---|
98 | .. W !!,"ECME Application Registration HL7 Message successfully created."
|
---|
99 | ;
|
---|
100 | FINI ; Clean up
|
---|
101 | K ^TMP("HLS",$J)
|
---|
102 | Q
|
---|