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