Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSJAREG

BPSJAREG.m

Go to the documentation of this file.
  1. BPSJAREG ;BHAM ISC/LJF - HL7 Application Registration MFN Message ;03/07/08 13:26
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7,20**;JUN 2004;Build 27
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; This program will process the outgoing registration MFN message
  1. ;
  1. ; Variables
  1. ; HL = HL7 parameters
  1. ; HL7DTG = Date time in HL7 format
  1. ; HLECH = HL7 Encoding Characters
  1. ; HLEID = HL7 Link id
  1. ; HLFS = HL7 Field separator
  1. ; HLLNK = HL7 E-Pharm Link
  1. ; HLRESET = HL7 generate results
  1. ; DNS = DNS Domain
  1. ; IPP = IP Port
  1. ; MCT = Message Count
  1. ; MGRP = E-Mail message group
  1. ; MSG = Message
  1. ;
  1. ;
  1. BPSJVAL(BPSJVAL) ; Validation entry point - HL7 message processing prevented
  1. ;
  1. TASKMAN ; Entry point for taskman to run this routine
  1. ;
  1. N DA,HL,HL7DTG,HLECH,HLEID,HLFS,HLLNK,HLRESET,HLPRO
  1. N IPP,DNS
  1. N MGRP,MSG,MCT,BPSJARES,BPVALFN,DA
  1. ;
  1. S MCT=0,BPSJVAL=+$G(BPSJVAL)
  1. K ^TMP("HLS",$J)
  1. ;
  1. S BPVALFN=9002313.99,DA=1
  1. ;
  1. ; Get Link data from HL7 table
  1. S HLPRO="BPSJ REGISTER",(DNS,IPP)="" ; BPS*20
  1. S HLLNK=$$FIND1^DIC(870,"",,"EPHARM OUT","B")
  1. I HLLNK S DNS=$$GET1^DIQ(870,HLLNK_",",.08),IPP=$$GET1^DIQ(870,HLLNK_",",400.02) ; BPS*20
  1. ;
  1. ; Error if any missing data
  1. I DNS=""!(IPP="") S MCT=MCT+1,MSG(MCT)="DNS Domain Address or TCP/IP Port is not defined in file #870." ; BPS*20
  1. I MCT,'BPSJVAL D MSG^BPSJUTL(.MSG,"BPSJAREG") Q
  1. ;
  1. ; Initialize the HL7
  1. D INIT^HLFNC2(HLPRO,.HL)
  1. I $G(HL) S MCT=MCT+1,MSG(MCT)="HL7 initialization failed.",MCT=MCT+1,MSG(MCT)=HL Q
  1. S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|"
  1. S HLECH=$E($G(HL("ECH")),1) I HLECH="" S HLECH="^"
  1. S HL("SITE")=$$SITE^VASITE,HL("SAF")=$P(HL("SITE"),U,2,3)
  1. S HL("EPPORT")=IPP,HLEID=$$HLP^BPSJUTL(HLPRO)
  1. ;
  1. ;Get fileman date/time, ensuring seconds are included: 3031029.135636
  1. S HL7DTG=$E($$HTFM^XLFDT($H)_"000000",1,14)
  1. ;Set HL7 Date/Time format: 20031029135636-0400
  1. S HL7DTG=$$FMTHL7^XLFDT(HL7DTG)
  1. ;
  1. ; Set the MFI segment
  1. S ^TMP("HLS",$J,1)="MFI"_HLFS_"Facility Table"_HLFS_HLFS_"UPD"_HLFS
  1. S ^TMP("HLS",$J,1)=^TMP("HLS",$J,1)_HL7DTG_HLFS_HL7DTG_HLFS_"NE"
  1. ;
  1. ; Set the MFE segment
  1. S ^TMP("HLS",$J,2)="MFE"_HLFS_"MUP"_HLFS_HLFS_HL7DTG_HLFS
  1. S ^TMP("HLS",$J,2)=^TMP("HLS",$J,2)_$P(HL("SITE"),"^",3)_HLFS_"ST"
  1. ;
  1. ; Set the ZQR segment
  1. S ^TMP("HLS",$J,3)=$$EN^BPSJZQR(.HL)
  1. ;
  1. S BPSJARES=$$VAL1^BPSJVAL(BPSJVAL) ; 0 = ok,
  1. I BPSJVAL=3 G FINI ; Just checking to see if data valid.
  1. ;
  1. ;-Check if msg valid.
  1. I 'BPSJARES D G FINI
  1. . N BPSHLRS
  1. . D GENERATE^HLMA(HLEID,"GM",1,.BPSHLRS,"")
  1. . I $P($G(BPSHLRS),U,2)]"" D Q
  1. .. I BPSJVAL D Q ; Interactive: show no success
  1. ... W !!,"ECME Application Registration HL7 Message not created: "_BPSHLRS
  1. .. S MCT=MCT+1,MSG(MCT)="ECME Application Registration HL7 Message not created."
  1. .. S MCT=MCT+1,MSG(MCT)=BPSHLRS
  1. .. D MSG^BPSJUTL(.MSG,"ECME Application Registration")
  1. . I BPSJVAL D ;Interactive: show success
  1. .. W !!,"ECME Application Registration HL7 Message successfully created."
  1. . S $P(^BPS(9002313.99,1,0),"^",4)=$$NOW^XLFDT
  1. ;
  1. FINI ; Clean up
  1. K ^TMP("HLS",$J)
  1. Q