BPSJAREG ;BHAM ISC/LJF - HL7 Application Registration MFN Message ;03/07/08 13:26
;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
; This program will process the outgoing registration MFN message
;
; Variables
; HL = HL7 parameters
; HL7DTG = Date time in HL7 format
; HLECH = HL7 Encoding Characters
; HLEID = HL7 Link id
; HLFS = HL7 Field separator
; HLLNK = HL7 E-Pharm Link
; HLRESET = HL7 generate results
; DNS = DNS Domain
; IPP = IP Port
; MCT = Message Count
; MGRP = E-Mail message group
; MSG = Message
;
;
BPSJVAL(BPSJVAL) ; Validation entry point - HL7 message processing prevented
;
TASKMAN ; Entry point for taskman to run this routine
;
N DA,HL,HL7DTG,HLECH,HLEID,HLFS,HLLNK,HLRESET,HLPRO
N IPP,DNS
N MGRP,MSG,MCT,BPSJARES,BPVALFN,DA
;
S MCT=0,BPSJVAL=+$G(BPSJVAL)
K ^TMP("HLS",$J)
;
S BPVALFN=9002313.99,DA=1
;
; Get Link data from HL7 table
S HLPRO="BPSJ REGISTER",(DNS,IPP)="" ; BPS*20
S HLLNK=$$FIND1^DIC(870,"",,"EPHARM OUT","B")
I HLLNK S DNS=$$GET1^DIQ(870,HLLNK_",",.08),IPP=$$GET1^DIQ(870,HLLNK_",",400.02) ; BPS*20
;
; Error if any missing data
I DNS=""!(IPP="") S MCT=MCT+1,MSG(MCT)="DNS Domain Address or TCP/IP Port is not defined in file #870." ; BPS*20
I MCT,'BPSJVAL D MSG^BPSJUTL(.MSG,"BPSJAREG") Q
;
; Initialize the HL7
D INIT^HLFNC2(HLPRO,.HL)
I $G(HL) S MCT=MCT+1,MSG(MCT)="HL7 initialization failed.",MCT=MCT+1,MSG(MCT)=HL Q
S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|"
S HLECH=$E($G(HL("ECH")),1) I HLECH="" S HLECH="^"
S HL("SITE")=$$SITE^VASITE,HL("SAF")=$P(HL("SITE"),U,2,3)
S HL("EPPORT")=IPP,HLEID=$$HLP^BPSJUTL(HLPRO)
;
;Get fileman date/time, ensuring seconds are included: 3031029.135636
S HL7DTG=$E($$HTFM^XLFDT($H)_"000000",1,14)
;Set HL7 Date/Time format: 20031029135636-0400
S HL7DTG=$$FMTHL7^XLFDT(HL7DTG)
;
; Set the MFI segment
S ^TMP("HLS",$J,1)="MFI"_HLFS_"Facility Table"_HLFS_HLFS_"UPD"_HLFS
S ^TMP("HLS",$J,1)=^TMP("HLS",$J,1)_HL7DTG_HLFS_HL7DTG_HLFS_"NE"
;
; Set the MFE segment
S ^TMP("HLS",$J,2)="MFE"_HLFS_"MUP"_HLFS_HLFS_HL7DTG_HLFS
S ^TMP("HLS",$J,2)=^TMP("HLS",$J,2)_$P(HL("SITE"),"^",3)_HLFS_"ST"
;
; Set the ZQR segment
S ^TMP("HLS",$J,3)=$$EN^BPSJZQR(.HL)
;
S BPSJARES=$$VAL1^BPSJVAL(BPSJVAL) ; 0 = ok,
I BPSJVAL=3 G FINI ; Just checking to see if data valid.
;
;-Check if msg valid.
I 'BPSJARES D G FINI
. N BPSHLRS
. D GENERATE^HLMA(HLEID,"GM",1,.BPSHLRS,"")
. I $P($G(BPSHLRS),U,2)]"" D Q
.. I BPSJVAL D Q ; Interactive: show no success
... W !!,"ECME Application Registration HL7 Message not created: "_BPSHLRS
.. S MCT=MCT+1,MSG(MCT)="ECME Application Registration HL7 Message not created."
.. S MCT=MCT+1,MSG(MCT)=BPSHLRS
.. D MSG^BPSJUTL(.MSG,"ECME Application Registration")
. I BPSJVAL D ;Interactive: show success
.. W !!,"ECME Application Registration HL7 Message successfully created."
. S $P(^BPS(9002313.99,1,0),"^",4)=$$NOW^XLFDT
;
FINI ; Clean up
K ^TMP("HLS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJAREG 3151 printed Dec 13, 2024@01:50:58 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This program will process the outgoing registration MFN message
+5 ;
+6 ; Variables
+7 ; HL = HL7 parameters
+8 ; HL7DTG = Date time in HL7 format
+9 ; HLECH = HL7 Encoding Characters
+10 ; HLEID = HL7 Link id
+11 ; HLFS = HL7 Field separator
+12 ; HLLNK = HL7 E-Pharm Link
+13 ; HLRESET = HL7 generate results
+14 ; DNS = DNS Domain
+15 ; IPP = IP Port
+16 ; MCT = Message Count
+17 ; MGRP = E-Mail message group
+18 ; MSG = Message
+19 ;
+20 ;
BPSJVAL(BPSJVAL) ; Validation entry point - HL7 message processing prevented
+1 ;
TASKMAN ; Entry point for taskman to run this routine
+1 ;
+2 NEW DA,HL,HL7DTG,HLECH,HLEID,HLFS,HLLNK,HLRESET,HLPRO
+3 NEW IPP,DNS
+4 NEW MGRP,MSG,MCT,BPSJARES,BPVALFN,DA
+5 ;
+6 SET MCT=0
SET BPSJVAL=+$GET(BPSJVAL)
+7 KILL ^TMP("HLS",$JOB)
+8 ;
+9 SET BPVALFN=9002313.99
SET DA=1
+10 ;
+11 ; Get Link data from HL7 table
+12 ; BPS*20
SET HLPRO="BPSJ REGISTER"
SET (DNS,IPP)=""
+13 SET HLLNK=$$FIND1^DIC(870,"",,"EPHARM OUT","B")
+14 ; BPS*20
IF HLLNK
SET DNS=$$GET1^DIQ(870,HLLNK_",",.08)
SET IPP=$$GET1^DIQ(870,HLLNK_",",400.02)
+15 ;
+16 ; Error if any missing data
+17 ; BPS*20
IF DNS=""!(IPP="")
SET MCT=MCT+1
SET MSG(MCT)="DNS Domain Address or TCP/IP Port is not defined in file #870."
+18 IF MCT
IF 'BPSJVAL
DO MSG^BPSJUTL(.MSG,"BPSJAREG")
QUIT
+19 ;
+20 ; Initialize the HL7
+21 DO INIT^HLFNC2(HLPRO,.HL)
+22 IF $GET(HL)
SET MCT=MCT+1
SET MSG(MCT)="HL7 initialization failed."
SET MCT=MCT+1
SET MSG(MCT)=HL
QUIT
+23 SET HLFS=$GET(HL("FS"))
IF HLFS=""
SET HLFS="|"
+24 SET HLECH=$EXTRACT($GET(HL("ECH")),1)
IF HLECH=""
SET HLECH="^"
+25 SET HL("SITE")=$$SITE^VASITE
SET HL("SAF")=$PIECE(HL("SITE"),U,2,3)
+26 SET HL("EPPORT")=IPP
SET HLEID=$$HLP^BPSJUTL(HLPRO)
+27 ;
+28 ;Get fileman date/time, ensuring seconds are included: 3031029.135636
+29 SET HL7DTG=$EXTRACT($$HTFM^XLFDT($HOROLOG)_"000000",1,14)
+30 ;Set HL7 Date/Time format: 20031029135636-0400
+31 SET HL7DTG=$$FMTHL7^XLFDT(HL7DTG)
+32 ;
+33 ; Set the MFI segment
+34 SET ^TMP("HLS",$JOB,1)="MFI"_HLFS_"Facility Table"_HLFS_HLFS_"UPD"_HLFS
+35 SET ^TMP("HLS",$JOB,1)=^TMP("HLS",$JOB,1)_HL7DTG_HLFS_HL7DTG_HLFS_"NE"
+36 ;
+37 ; Set the MFE segment
+38 SET ^TMP("HLS",$JOB,2)="MFE"_HLFS_"MUP"_HLFS_HLFS_HL7DTG_HLFS
+39 SET ^TMP("HLS",$JOB,2)=^TMP("HLS",$JOB,2)_$PIECE(HL("SITE"),"^",3)_HLFS_"ST"
+40 ;
+41 ; Set the ZQR segment
+42 SET ^TMP("HLS",$JOB,3)=$$EN^BPSJZQR(.HL)
+43 ;
+44 ; 0 = ok,
SET BPSJARES=$$VAL1^BPSJVAL(BPSJVAL)
+45 ; Just checking to see if data valid.
IF BPSJVAL=3
GOTO FINI
+46 ;
+47 ;-Check if msg valid.
+48 IF 'BPSJARES
Begin DoDot:1
+49 NEW BPSHLRS
+50 DO GENERATE^HLMA(HLEID,"GM",1,.BPSHLRS,"")
+51 IF $PIECE($GET(BPSHLRS),U,2)]""
Begin DoDot:2
+52 ; Interactive: show no success
IF BPSJVAL
Begin DoDot:3
+53 WRITE !!,"ECME Application Registration HL7 Message not created: "_BPSHLRS
End DoDot:3
QUIT
+54 SET MCT=MCT+1
SET MSG(MCT)="ECME Application Registration HL7 Message not created."
+55 SET MCT=MCT+1
SET MSG(MCT)=BPSHLRS
+56 DO MSG^BPSJUTL(.MSG,"ECME Application Registration")
End DoDot:2
QUIT
+57 ;Interactive: show success
IF BPSJVAL
Begin DoDot:2
+58 WRITE !!,"ECME Application Registration HL7 Message successfully created."
End DoDot:2
+59 SET $PIECE(^BPS(9002313.99,1,0),"^",4)=$$NOW^XLFDT
End DoDot:1
GOTO FINI
+60 ;
FINI ; Clean up
+1 KILL ^TMP("HLS",$JOB)
+2 QUIT