- 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 Jan 18, 2025@02:52:11 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