BPSJPREG ;BHAM ISC/LJF - HL7 Registration MFN Message ;6/12/08 15:38
;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program will process the outgoing registration MFN message
;
; Variable
; 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 Address
; IPP = IP Port
; MCT = Message Count
; MGRP = E-Mail message group
; MSG = Message
;
; Don't allow direct execution
;
W !!!,"DIRECT ENTRY NOT ALLOWED",!!!
Q
;
REG(PHARMIX,BPSJVAL) ; Registration message for when a site installs
;
N HL,HL7DTG,HLECH,HLEID,HLFS,HLLNK,HLPRO,BPSHLRS,IPP,NPKEY,NCPDP
N MGRP,MCT,MSG,TAXID,ZRPSEG,BPSJVAL2,BPSJPRES,BPSZ,DNS
;
S (MCT,TAXID)=0,BPSJVAL=$G(BPSJVAL)
;
I '$G(PHARMIX) Q
K ^TMP("HLS",$J)
;
; only send Active or recently made inactive pharmacies, no reason to send
; inactive ones over and over
S BPSZ=$G(^BPS(9002313.56,PHARMIX,0))
I 'BPSJVAL,'$P(BPSZ,"^",10),'$P(BPSZ,"^",4) Q
;
; NPI Processing
; Get DropDeadDate and Date/Time Last Change
N BPSJAPI,BPSJNPI,BPSJNDT,BPSJOP,BPSJOPS,BPSJDDD,NPKEY
S BPSJDDD=$$NPIREQ^BPSNPI(DT)
N NOW,%,%H,%I,X D NOW^%DTC S BPSJNDT=%
; Get OP site for pharmacy and NPIAPI
S BPSJOP=0,BPSJAPI=""
F S BPSJOP=$O(^BPS(9002313.56,PHARMIX,"OPSITE",BPSJOP)) Q:'BPSJOP D I BPSJAPI'="" Q
. S BPSJOPS=$G(^BPS(9002313.56,PHARMIX,"OPSITE",BPSJOP,0))
. S BPSJAPI=$$NPI^BPSNPI("Pharmacy_ID",BPSJOPS)
. I $P(BPSJAPI,U,1)=-1 S BPSJAPI="" Q
. I $P(BPSJAPI,U)>0 S BPSJAPI=$P(BPSJAPI,U)
; Check for existing NPI
S BPSJNPI=$P($G(^BPS(9002313.56,PHARMIX,"NPI")),U)
I 'BPSJAPI,BPSJNPI,BPSJVAL<2 D
. N DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
. S DA=PHARMIX,DIE=$$ROOT^DILFD(9002313.56)
. S DR="41.01///@;41.02///@" D ^DIE
I BPSJAPI,BPSJVAL<2 D
. S ^XTMP("BPSJ",0)=(BPSJNDT+7)_U_BPSJNDT_U_"BPS NPI HL7 DATA"
. S ^XTMP("BPSJ","NPI",BPSJAPI)=PHARMIX_U_BPSJNDT
;
; 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
;
; Initialize the HL7
D INIT^HLFNC2(HLPRO,.HL)
S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|"
S HLECH=$E($G(HL("ECH"),1)) I HLECH="" S HLECH="^"
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 ZRP Segment
D EN^BPSJZRP(.HL,PHARMIX,.ZRPSEG,BPSJAPI,.NCPDP)
M ^TMP("HLS",$J,3)=ZRPSEG K ZRPSEG
;
; Set the MFE segment
N BPSMFE S BPSMFE="MUP"
S NPKEY=$$NPKEY^BPSNPI(NCPDP,BPSJNPI,BPSJAPI)
I NPKEY D
. I '$$BPSACTV^BPSUTIL(PHARMIX) S BPSMFE="MDC"
. S ^TMP("HLS",$J,2)="MFE"_HLFS_BPSMFE_HLFS_HLFS_HL7DTG
. S ^TMP("HLS",$J,2)=^TMP("HLS",$J,2)_HLFS_NPKEY_HLFS_"ST"
;
; Set the MFI segment
S ^TMP("HLS",$J,1)="MFI"_HLFS_"Pharmacy Table"_HLFS_HLFS_"UPD"_HLFS
S ^TMP("HLS",$J,1)=^TMP("HLS",$J,1)_HL7DTG_HLFS_HL7DTG_HLFS_"NE"
;
S BPSJPRES=$$VAL2^BPSJVAL(BPSJVAL,BPSJDDD) ; 0 = ok
I BPSJVAL=3 G FINI ; Just checking to see if data valid.
;
;-Check if msg valid.
I 'BPSJPRES 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 Pharmacy Registration HL7 Message not created: "_BPSHLRS
... W !," PHARMIX: "_PHARMIX_""
.. S MCT=MCT+1,MSG(MCT)="ECME Pharmacy Registration HL7 Message not created. (PHARMIX: "_PHARMIX_")"
.. S MCT=MCT+1,MSG(MCT)=BPSHLRS
.. D MSG^BPSJUTL(.MSG,"ECME Pharmacy Registration")
. ; update last status sent
. S $P(^BPS(9002313.56,PHARMIX,0),"^",4)=$P(^BPS(9002313.56,PHARMIX,0),"^",10)
. I BPSJVAL D ;Interactive: show success
.. W !!,"ECME Pharmacy Registration HL7 Message was created successfully."
;
;
FINI ; Clean up
K ^TMP("HLS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJPREG 4459 printed Oct 16, 2024@17:51:52 Page 2
BPSJPREG ;BHAM ISC/LJF - HL7 Registration MFN Message ;6/12/08 15:38
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program will process the outgoing registration MFN message
+6 ;
+7 ; Variable
+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 ; DNS = DNS Domain Address
+16 ; IPP = IP Port
+17 ; MCT = Message Count
+18 ; MGRP = E-Mail message group
+19 ; MSG = Message
+20 ;
+21 ; Don't allow direct execution
+22 ;
+23 WRITE !!!,"DIRECT ENTRY NOT ALLOWED",!!!
+24 QUIT
+25 ;
REG(PHARMIX,BPSJVAL) ; Registration message for when a site installs
+1 ;
+2 NEW HL,HL7DTG,HLECH,HLEID,HLFS,HLLNK,HLPRO,BPSHLRS,IPP,NPKEY,NCPDP
+3 NEW MGRP,MCT,MSG,TAXID,ZRPSEG,BPSJVAL2,BPSJPRES,BPSZ,DNS
+4 ;
+5 SET (MCT,TAXID)=0
SET BPSJVAL=$GET(BPSJVAL)
+6 ;
+7 IF '$GET(PHARMIX)
QUIT
+8 KILL ^TMP("HLS",$JOB)
+9 ;
+10 ; only send Active or recently made inactive pharmacies, no reason to send
+11 ; inactive ones over and over
+12 SET BPSZ=$GET(^BPS(9002313.56,PHARMIX,0))
+13 IF 'BPSJVAL
IF '$PIECE(BPSZ,"^",10)
IF '$PIECE(BPSZ,"^",4)
QUIT
+14 ;
+15 ; NPI Processing
+16 ; Get DropDeadDate and Date/Time Last Change
+17 NEW BPSJAPI,BPSJNPI,BPSJNDT,BPSJOP,BPSJOPS,BPSJDDD,NPKEY
+18 SET BPSJDDD=$$NPIREQ^BPSNPI(DT)
+19 NEW NOW,%,%H,%I,X
DO NOW^%DTC
SET BPSJNDT=%
+20 ; Get OP site for pharmacy and NPIAPI
+21 SET BPSJOP=0
SET BPSJAPI=""
+22 FOR
SET BPSJOP=$ORDER(^BPS(9002313.56,PHARMIX,"OPSITE",BPSJOP))
if 'BPSJOP
QUIT
Begin DoDot:1
+23 SET BPSJOPS=$GET(^BPS(9002313.56,PHARMIX,"OPSITE",BPSJOP,0))
+24 SET BPSJAPI=$$NPI^BPSNPI("Pharmacy_ID",BPSJOPS)
+25 IF $PIECE(BPSJAPI,U,1)=-1
SET BPSJAPI=""
QUIT
+26 IF $PIECE(BPSJAPI,U)>0
SET BPSJAPI=$PIECE(BPSJAPI,U)
End DoDot:1
IF BPSJAPI'=""
QUIT
+27 ; Check for existing NPI
+28 SET BPSJNPI=$PIECE($GET(^BPS(9002313.56,PHARMIX,"NPI")),U)
+29 IF 'BPSJAPI
IF BPSJNPI
IF BPSJVAL<2
Begin DoDot:1
+30 NEW DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
+31 SET DA=PHARMIX
SET DIE=$$ROOT^DILFD(9002313.56)
+32 SET DR="41.01///@;41.02///@"
DO ^DIE
End DoDot:1
+33 IF BPSJAPI
IF BPSJVAL<2
Begin DoDot:1
+34 SET ^XTMP("BPSJ",0)=(BPSJNDT+7)_U_BPSJNDT_U_"BPS NPI HL7 DATA"
+35 SET ^XTMP("BPSJ","NPI",BPSJAPI)=PHARMIX_U_BPSJNDT
End DoDot:1
+36 ;
+37 ; Get Link data from HL7 table
+38 ; BPS*20
SET HLPRO="BPSJ REGISTER"
SET (DNS,IPP)=""
+39 SET HLLNK=$$FIND1^DIC(870,"",,"EPHARM OUT","B")
+40 ; BPS*20
IF HLLNK
SET DNS=$$GET1^DIQ(870,HLLNK_",",.08)
SET IPP=$$GET1^DIQ(870,HLLNK_",",400.02)
+41 ;
+42 ; Error if any missing data
+43 ; 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."
+44 ;
+45 ; Initialize the HL7
+46 DO INIT^HLFNC2(HLPRO,.HL)
+47 SET HLFS=$GET(HL("FS"))
IF HLFS=""
SET HLFS="|"
+48 SET HLECH=$EXTRACT($GET(HL("ECH"),1))
IF HLECH=""
SET HLECH="^"
+49 SET HL("EPPORT")=IPP
SET HLEID=$$HLP^BPSJUTL(HLPRO)
+50 ;
+51 ;Get fileman date/time, ensuring seconds are included: 3031029.135636
+52 SET HL7DTG=$EXTRACT($$HTFM^XLFDT($HOROLOG)_"000000",1,14)
+53 ;Set HL7 Date/Time format: 20031029135636-0400
+54 SET HL7DTG=$$FMTHL7^XLFDT(HL7DTG)
+55 ;
+56 ; Set the ZRP Segment
+57 DO EN^BPSJZRP(.HL,PHARMIX,.ZRPSEG,BPSJAPI,.NCPDP)
+58 MERGE ^TMP("HLS",$JOB,3)=ZRPSEG
KILL ZRPSEG
+59 ;
+60 ; Set the MFE segment
+61 NEW BPSMFE
SET BPSMFE="MUP"
+62 SET NPKEY=$$NPKEY^BPSNPI(NCPDP,BPSJNPI,BPSJAPI)
+63 IF NPKEY
Begin DoDot:1
+64 IF '$$BPSACTV^BPSUTIL(PHARMIX)
SET BPSMFE="MDC"
+65 SET ^TMP("HLS",$JOB,2)="MFE"_HLFS_BPSMFE_HLFS_HLFS_HL7DTG
+66 SET ^TMP("HLS",$JOB,2)=^TMP("HLS",$JOB,2)_HLFS_NPKEY_HLFS_"ST"
End DoDot:1
+67 ;
+68 ; Set the MFI segment
+69 SET ^TMP("HLS",$JOB,1)="MFI"_HLFS_"Pharmacy Table"_HLFS_HLFS_"UPD"_HLFS
+70 SET ^TMP("HLS",$JOB,1)=^TMP("HLS",$JOB,1)_HL7DTG_HLFS_HL7DTG_HLFS_"NE"
+71 ;
+72 ; 0 = ok
SET BPSJPRES=$$VAL2^BPSJVAL(BPSJVAL,BPSJDDD)
+73 ; Just checking to see if data valid.
IF BPSJVAL=3
GOTO FINI
+74 ;
+75 ;-Check if msg valid.
+76 IF 'BPSJPRES
Begin DoDot:1
+77 NEW BPSHLRS
+78 DO GENERATE^HLMA(HLEID,"GM",1,.BPSHLRS,"")
+79 IF $PIECE($GET(BPSHLRS),U,2)]""
Begin DoDot:2
+80 ; Interactive: show no success
IF BPSJVAL
Begin DoDot:3
+81 WRITE !!,"ECME Pharmacy Registration HL7 Message not created: "_BPSHLRS
+82 WRITE !," PHARMIX: "_PHARMIX_""
End DoDot:3
QUIT
+83 SET MCT=MCT+1
SET MSG(MCT)="ECME Pharmacy Registration HL7 Message not created. (PHARMIX: "_PHARMIX_")"
+84 SET MCT=MCT+1
SET MSG(MCT)=BPSHLRS
+85 DO MSG^BPSJUTL(.MSG,"ECME Pharmacy Registration")
End DoDot:2
QUIT
+86 ; update last status sent
+87 SET $PIECE(^BPS(9002313.56,PHARMIX,0),"^",4)=$PIECE(^BPS(9002313.56,PHARMIX,0),"^",10)
+88 ;Interactive: show success
IF BPSJVAL
Begin DoDot:2
+89 WRITE !!,"ECME Pharmacy Registration HL7 Message was created successfully."
End DoDot:2
End DoDot:1
GOTO FINI
+90 ;
+91 ;
FINI ; Clean up
+1 KILL ^TMP("HLS",$JOB)
+2 QUIT
