source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSJAREG.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1BPSJAREG ;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 ;
21INI ;
22INIT ; Unconditional jump....
23 G ^BPSJINIT
24 Q
25 ;
26BPSJVAL(BPSJVAL) ; Validation entry point - HL7 message processing prevented
27 ;
28TASKMAN ; 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 ;
100FINI ; Clean up
101 K ^TMP("HLS",$J)
102 Q
Note: See TracBrowser for help on using the repository browser.