| 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
 | 
|---|