BPSJACK ;BHAM ISC/LJF - HL7 Acknowledgement Messages ;3/13/08 16:08
;;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 routine examines an Acknowledgement Message. If the message is
; the E-PHARM Application Acknowledgement Message, and it is "AA",
; it kicks off the Pharmacy Registration Messages.
; If the message flags an error, then error notification is processed.
;
EN(HL) N ACK,AREG,BPSJSEG,ERR,HCT,SEG
N MFI,MFIIX,MSGCTLID,MSGID,MSGIX,MSH
;
I '$D(HL) Q
;
S (AREG,HCT,MFIIX,MSGCTLID,MSGID,MSGIX)=0,(ACK,MFI,MSH)=""
S ERR("MSA")=""
; Loop through the message and find each segment for processing
F S HCT=$O(^TMP($J,"BPSJHLI",HCT)) Q:HCT="" D
. K BPSJSEG D SPAR^BPSJUTL(.HL,.BPSJSEG,HCT) S SEG=$G(BPSJSEG(1))
. ;
. I SEG="MSH" D Q
. . S MSGCTLID=$G(BPSJSEG(10)) ; get the message control id
. ;
. I SEG="MSA" D Q ; MSA seg looks like this -> MSA|AA|509133482
. . S ACK=$G(BPSJSEG(2)),MSGID=$G(BPSJSEG(3)) K ERR("MSA")
. ;
. I SEG="MFI",ACK="AA",$P($G(BPSJSEG(2)),$E($G(HL("ECH"))))="Facility Table" S AREG=1
. ;
. ;GET NPI
. I SEG="MFI",ACK="AA",$P($G(BPSJSEG(2)),$E($G(HL("ECH"))))="Pharmacy Table" D
. . I '$G(MSGID) Q
. . N BPSJNPI,BPSJPIX,BPSJNDT,BPSJ,HLMAID,HLID
. . ; back track AA/ACK to message sent out to find NPI sent out
. . S HLMAID=$O(^HLMA("C",MSGID,"")) I '$G(HLMAID) Q
. . S HLID=$P(^HLMA(HLMAID,0),U) I '$G(HLID) Q
. . S BPSJNPI=$P($G(^HL(772,HLID,"IN",22,0)),"|") I '$G(BPSJNPI) Q
. . S BPSJ=$G(^XTMP("BPSJ","NPI",BPSJNPI)) I 'BPSJ Q
. . S BPSJPIX=$P(BPSJ,U),BPSJNDT=$P(BPSJ,U,2)
. . N DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
. . S DA=BPSJPIX,DIE=$$ROOT^DILFD(9002313.56)
. . S DR="41.01////"_BPSJNPI_";41.02////"_BPSJNDT D ^DIE
. . K ^XTMP("BPSJ","NPI",BPSJNPI)
. ;
. I SEG="MFA",ACK="AE" S ERR("MFA",U_$G(BPSJSEG(5)))="" Q
;
; Pharmacy Registrations
I AREG S AREG=0 D
. S $P(^BPS(9002313.99,1,0),"^",7)=$$NOW^XLFDT
. F S AREG=$O(^BPS(9002313.56,AREG)) Q:'AREG D REG^BPSJPREG(AREG)
;
I $D(ERR) D ERRORM D MSG^BPSJUTL(.ERR,"BPSJACK")
Q
;
ERRORM ; Error message setup
N ERRT
;
S ERR(1)="Error(s) indicated for HL7 Application Acknowledge Message ID: "_$G(MSGCTLID)
I $D(ERR("MSA")) S ERR(2)="Error:NO MSA - No MSA segment found."
I $D(ERR("MFA")) S ERRT="" F S ERRT=$O(ERR("MFA",ERRT)) Q:ERRT="" D
. I ERRT["NC100" S ERR(100)="Error:NC100 - Invalid OP Interface version." Q
. I ERRT["NC300" S ERR(300)="Error:NC300 - OP pharmacy not registered. Failed to update Pharmacy information." Q
. I ERRT["NC301" S ERR(301)="Error:NC301 - Unable to update Pharmacy information due to outpatient pharmacy registration has invalid OP interface version." Q
. S ERR(399)="Error:"_ERRT_" - Unknown error."
K ERR("MFA"),ERR("MSA")
;
Q
;
APPACK(HL,APPACK,PSIEN) ; Application Acknowledgement for Payer Sheets
N MGRP,MSG,MCT,BPSGENR
N TLN,FS,FS2,FS3,CS
;
K ^TMP("HLA",$J)
;
;-Set up HL7
D INIT^HLFNC2("BPSJ REGISTER",.HL)
;
D DGAPPACK ; Dollar G the APPACK variable (bullet proofing)
;
S FS=$G(HL("FS")) I FS="" S FS="|" ; field separator
S CS=$E($G(HL("ECH"))) I CS="" S CS="^" ; component separator
;
S MCT=0,FS2=FS_FS,FS3=FS_FS_FS
;
;-MSA SEG
I APPACK("MFA",4,1)="S" S ^TMP("HLA",$J,1)="MSA"_FS_"AA"_FS_APPACK("MSA",2)
E S ^TMP("HLA",$J,1)="MSA"_FS_"AE"_FS_APPACK("MSA",2)
;
;-MFI SEG
S TLN="MFI"_FS_APPACK("MFI",1,1)_CS_APPACK("MFI",1,2)_FS2
S ^TMP("HLA",$J,2)=TLN_APPACK("MFI",3)_FS3_APPACK("MFI",6)
;
;-MFA SEG(S)
I APPACK("MFA",4,1)="S" D S ^TMP("HLA",$J,3)=TLN
. S TLN="MFA"_FS_APPACK("MFA",1)_FS_APPACK("MFA",2)_FS2
. S TLN=TLN_APPACK("MFA",4,1)_CS_APPACK("MFA",4,2)_FS
. S TLN=TLN_APPACK("MFA",5)_FS_APPACK("MFA",6)
E D MFASEGS
;
D GENACK^HLMA1($G(HL("EID")),$G(HL("HLMTIENS")),$G(HL("EIDS")),"GM",1,.BPSGENR)
;
K ^TMP("HLA",$J)
Q
;
MFASEGS ; Set up the MFA segs for Reject message
N MFAP1,MFAP2,MFACNTR,FIELD,RECORD,ZPRERR
;
S MFAP1="MFA"_FS_APPACK("MFA",1)_FS_APPACK("MFA",2)
S MFAP1=MFAP1_FS2_APPACK("MFA",4,1)_CS
S MFAP2=FS_APPACK("MFA",5)_FS_APPACK("MFA",6)
S MFACNTR=2
;
I $D(^TMP($J,"BPSJ-ERROR","MFI")) S FIELD="" D
. F S FIELD=$O(^TMP($J,"BPSJ-ERROR","MFI",FIELD)) Q:'FIELD D
.. S MFACNTR=MFACNTR+1
.. S ^TMP("HLA",$J,MFACNTR)=MFAP1_"V60"_FIELD_MFAP2
;
I $D(^TMP($J,"BPSJ-ERROR","MFE")) S FIELD="" D
. F S FIELD=$O(^TMP($J,"BPSJ-ERROR","MFE",FIELD)) Q:'FIELD D
.. S MFACNTR=MFACNTR+1
.. S ^TMP("HLA",$J,MFACNTR)=MFAP1_"V61"_FIELD_MFAP2
;
I $D(^TMP($J,"BPSJ-ERROR","ZPS")) S FIELD="" D
. F S FIELD=$O(^TMP($J,"BPSJ-ERROR","ZPS",FIELD)) Q:'FIELD D
.. S MFACNTR=MFACNTR+1
.. S ^TMP("HLA",$J,MFACNTR)=MFAP1_"V62"_FIELD_MFAP2
;
I $D(^TMP($J,"BPSJ-ERROR","ZPR")) S RECORD="" D
. F S RECORD=$O(^TMP($J,"BPSJ-ERROR","ZPR",RECORD)),FIELD="" Q:'RECORD D
.. F S FIELD=$O(^TMP($J,"BPSJ-ERROR","ZPR",RECORD,FIELD)) Q:'FIELD D
... S ZPRERR=$G(^TMP($J,"BPSJ-ERROR","ZPR",RECORD,FIELD))
... S MFACNTR=MFACNTR+1,^TMP("HLA",$J,MFACNTR)=MFAP1_ZPRERR_MFAP2
;
Q
DGAPPACK ; $G the APPACK var
S APPACK("MFA",1)=$G(APPACK("MFA",1))
S APPACK("MFA",2)=$G(APPACK("MFA",2))
S APPACK("MFA",3)=$G(APPACK("MFA",3))
S APPACK("MFA",4,1)=$G(APPACK("MFA",4,1))
S APPACK("MFA",4,2)=$G(APPACK("MFA",4,2))
S APPACK("MFA",5)=$G(APPACK("MFA",5))
S APPACK("MFA",6)=$G(APPACK("MFA",6))
S APPACK("MFI",1,1)=$G(APPACK("MFI",1,1))
S APPACK("MFI",1,2)=$G(APPACK("MFI",1,2))
S APPACK("MFI",3)=$G(APPACK("MFI",3))
S APPACK("MFI",6)=$G(APPACK("MFI",6))
S APPACK("MSA",1)=$G(APPACK("MSA",1))
S APPACK("MSA",2)=$G(APPACK("MSA",2))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJACK 5733 printed Dec 13, 2024@01:50:57 Page 2
BPSJACK ;BHAM ISC/LJF - HL7 Acknowledgement Messages ;3/13/08 16:08
+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 routine examines an Acknowledgement Message. If the message is
+5 ; the E-PHARM Application Acknowledgement Message, and it is "AA",
+6 ; it kicks off the Pharmacy Registration Messages.
+7 ; If the message flags an error, then error notification is processed.
+8 ;
EN(HL) NEW ACK,AREG,BPSJSEG,ERR,HCT,SEG
+1 NEW MFI,MFIIX,MSGCTLID,MSGID,MSGIX,MSH
+2 ;
+3 IF '$DATA(HL)
QUIT
+4 ;
+5 SET (AREG,HCT,MFIIX,MSGCTLID,MSGID,MSGIX)=0
SET (ACK,MFI,MSH)=""
+6 SET ERR("MSA")=""
+7 ; Loop through the message and find each segment for processing
+8 FOR
SET HCT=$ORDER(^TMP($JOB,"BPSJHLI",HCT))
if HCT=""
QUIT
Begin DoDot:1
+9 KILL BPSJSEG
DO SPAR^BPSJUTL(.HL,.BPSJSEG,HCT)
SET SEG=$GET(BPSJSEG(1))
+10 ;
+11 IF SEG="MSH"
Begin DoDot:2
+12 ; get the message control id
SET MSGCTLID=$GET(BPSJSEG(10))
End DoDot:2
QUIT
+13 ;
+14 ; MSA seg looks like this -> MSA|AA|509133482
IF SEG="MSA"
Begin DoDot:2
+15 SET ACK=$GET(BPSJSEG(2))
SET MSGID=$GET(BPSJSEG(3))
KILL ERR("MSA")
End DoDot:2
QUIT
+16 ;
+17 IF SEG="MFI"
IF ACK="AA"
IF $PIECE($GET(BPSJSEG(2)),$EXTRACT($GET(HL("ECH"))))="Facility Table"
SET AREG=1
+18 ;
+19 ;GET NPI
+20 IF SEG="MFI"
IF ACK="AA"
IF $PIECE($GET(BPSJSEG(2)),$EXTRACT($GET(HL("ECH"))))="Pharmacy Table"
Begin DoDot:2
+21 IF '$GET(MSGID)
QUIT
+22 NEW BPSJNPI,BPSJPIX,BPSJNDT,BPSJ,HLMAID,HLID
+23 ; back track AA/ACK to message sent out to find NPI sent out
+24 SET HLMAID=$ORDER(^HLMA("C",MSGID,""))
IF '$GET(HLMAID)
QUIT
+25 SET HLID=$PIECE(^HLMA(HLMAID,0),U)
IF '$GET(HLID)
QUIT
+26 SET BPSJNPI=$PIECE($GET(^HL(772,HLID,"IN",22,0)),"|")
IF '$GET(BPSJNPI)
QUIT
+27 SET BPSJ=$GET(^XTMP("BPSJ","NPI",BPSJNPI))
IF 'BPSJ
QUIT
+28 SET BPSJPIX=$PIECE(BPSJ,U)
SET BPSJNDT=$PIECE(BPSJ,U,2)
+29 NEW DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
+30 SET DA=BPSJPIX
SET DIE=$$ROOT^DILFD(9002313.56)
+31 SET DR="41.01////"_BPSJNPI_";41.02////"_BPSJNDT
DO ^DIE
+32 KILL ^XTMP("BPSJ","NPI",BPSJNPI)
End DoDot:2
+33 ;
+34 IF SEG="MFA"
IF ACK="AE"
SET ERR("MFA",U_$GET(BPSJSEG(5)))=""
QUIT
End DoDot:1
+35 ;
+36 ; Pharmacy Registrations
+37 IF AREG
SET AREG=0
Begin DoDot:1
+38 SET $PIECE(^BPS(9002313.99,1,0),"^",7)=$$NOW^XLFDT
+39 FOR
SET AREG=$ORDER(^BPS(9002313.56,AREG))
if 'AREG
QUIT
DO REG^BPSJPREG(AREG)
End DoDot:1
+40 ;
+41 IF $DATA(ERR)
DO ERRORM
DO MSG^BPSJUTL(.ERR,"BPSJACK")
+42 QUIT
+43 ;
ERRORM ; Error message setup
+1 NEW ERRT
+2 ;
+3 SET ERR(1)="Error(s) indicated for HL7 Application Acknowledge Message ID: "_$GET(MSGCTLID)
+4 IF $DATA(ERR("MSA"))
SET ERR(2)="Error:NO MSA - No MSA segment found."
+5 IF $DATA(ERR("MFA"))
SET ERRT=""
FOR
SET ERRT=$ORDER(ERR("MFA",ERRT))
if ERRT=""
QUIT
Begin DoDot:1
+6 IF ERRT["NC100"
SET ERR(100)="Error:NC100 - Invalid OP Interface version."
QUIT
+7 IF ERRT["NC300"
SET ERR(300)="Error:NC300 - OP pharmacy not registered. Failed to update Pharmacy information."
QUIT
+8 IF ERRT["NC301"
SET ERR(301)="Error:NC301 - Unable to update Pharmacy information due to outpatient pharmacy registration has invalid OP interface version."
QUIT
+9 SET ERR(399)="Error:"_ERRT_" - Unknown error."
End DoDot:1
+10 KILL ERR("MFA"),ERR("MSA")
+11 ;
+12 QUIT
+13 ;
APPACK(HL,APPACK,PSIEN) ; Application Acknowledgement for Payer Sheets
+1 NEW MGRP,MSG,MCT,BPSGENR
+2 NEW TLN,FS,FS2,FS3,CS
+3 ;
+4 KILL ^TMP("HLA",$JOB)
+5 ;
+6 ;-Set up HL7
+7 DO INIT^HLFNC2("BPSJ REGISTER",.HL)
+8 ;
+9 ; Dollar G the APPACK variable (bullet proofing)
DO DGAPPACK
+10 ;
+11 ; field separator
SET FS=$GET(HL("FS"))
IF FS=""
SET FS="|"
+12 ; component separator
SET CS=$EXTRACT($GET(HL("ECH")))
IF CS=""
SET CS="^"
+13 ;
+14 SET MCT=0
SET FS2=FS_FS
SET FS3=FS_FS_FS
+15 ;
+16 ;-MSA SEG
+17 IF APPACK("MFA",4,1)="S"
SET ^TMP("HLA",$JOB,1)="MSA"_FS_"AA"_FS_APPACK("MSA",2)
+18 IF '$TEST
SET ^TMP("HLA",$JOB,1)="MSA"_FS_"AE"_FS_APPACK("MSA",2)
+19 ;
+20 ;-MFI SEG
+21 SET TLN="MFI"_FS_APPACK("MFI",1,1)_CS_APPACK("MFI",1,2)_FS2
+22 SET ^TMP("HLA",$JOB,2)=TLN_APPACK("MFI",3)_FS3_APPACK("MFI",6)
+23 ;
+24 ;-MFA SEG(S)
+25 IF APPACK("MFA",4,1)="S"
Begin DoDot:1
+26 SET TLN="MFA"_FS_APPACK("MFA",1)_FS_APPACK("MFA",2)_FS2
+27 SET TLN=TLN_APPACK("MFA",4,1)_CS_APPACK("MFA",4,2)_FS
+28 SET TLN=TLN_APPACK("MFA",5)_FS_APPACK("MFA",6)
End DoDot:1
SET ^TMP("HLA",$JOB,3)=TLN
+29 IF '$TEST
DO MFASEGS
+30 ;
+31 DO GENACK^HLMA1($GET(HL("EID")),$GET(HL("HLMTIENS")),$GET(HL("EIDS")),"GM",1,.BPSGENR)
+32 ;
+33 KILL ^TMP("HLA",$JOB)
+34 QUIT
+35 ;
MFASEGS ; Set up the MFA segs for Reject message
+1 NEW MFAP1,MFAP2,MFACNTR,FIELD,RECORD,ZPRERR
+2 ;
+3 SET MFAP1="MFA"_FS_APPACK("MFA",1)_FS_APPACK("MFA",2)
+4 SET MFAP1=MFAP1_FS2_APPACK("MFA",4,1)_CS
+5 SET MFAP2=FS_APPACK("MFA",5)_FS_APPACK("MFA",6)
+6 SET MFACNTR=2
+7 ;
+8 IF $DATA(^TMP($JOB,"BPSJ-ERROR","MFI"))
SET FIELD=""
Begin DoDot:1
+9 FOR
SET FIELD=$ORDER(^TMP($JOB,"BPSJ-ERROR","MFI",FIELD))
if 'FIELD
QUIT
Begin DoDot:2
+10 SET MFACNTR=MFACNTR+1
+11 SET ^TMP("HLA",$JOB,MFACNTR)=MFAP1_"V60"_FIELD_MFAP2
End DoDot:2
End DoDot:1
+12 ;
+13 IF $DATA(^TMP($JOB,"BPSJ-ERROR","MFE"))
SET FIELD=""
Begin DoDot:1
+14 FOR
SET FIELD=$ORDER(^TMP($JOB,"BPSJ-ERROR","MFE",FIELD))
if 'FIELD
QUIT
Begin DoDot:2
+15 SET MFACNTR=MFACNTR+1
+16 SET ^TMP("HLA",$JOB,MFACNTR)=MFAP1_"V61"_FIELD_MFAP2
End DoDot:2
End DoDot:1
+17 ;
+18 IF $DATA(^TMP($JOB,"BPSJ-ERROR","ZPS"))
SET FIELD=""
Begin DoDot:1
+19 FOR
SET FIELD=$ORDER(^TMP($JOB,"BPSJ-ERROR","ZPS",FIELD))
if 'FIELD
QUIT
Begin DoDot:2
+20 SET MFACNTR=MFACNTR+1
+21 SET ^TMP("HLA",$JOB,MFACNTR)=MFAP1_"V62"_FIELD_MFAP2
End DoDot:2
End DoDot:1
+22 ;
+23 IF $DATA(^TMP($JOB,"BPSJ-ERROR","ZPR"))
SET RECORD=""
Begin DoDot:1
+24 FOR
SET RECORD=$ORDER(^TMP($JOB,"BPSJ-ERROR","ZPR",RECORD))
SET FIELD=""
if 'RECORD
QUIT
Begin DoDot:2
+25 FOR
SET FIELD=$ORDER(^TMP($JOB,"BPSJ-ERROR","ZPR",RECORD,FIELD))
if 'FIELD
QUIT
Begin DoDot:3
+26 SET ZPRERR=$GET(^TMP($JOB,"BPSJ-ERROR","ZPR",RECORD,FIELD))
+27 SET MFACNTR=MFACNTR+1
SET ^TMP("HLA",$JOB,MFACNTR)=MFAP1_ZPRERR_MFAP2
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 QUIT
DGAPPACK ; $G the APPACK var
+1 SET APPACK("MFA",1)=$GET(APPACK("MFA",1))
+2 SET APPACK("MFA",2)=$GET(APPACK("MFA",2))
+3 SET APPACK("MFA",3)=$GET(APPACK("MFA",3))
+4 SET APPACK("MFA",4,1)=$GET(APPACK("MFA",4,1))
+5 SET APPACK("MFA",4,2)=$GET(APPACK("MFA",4,2))
+6 SET APPACK("MFA",5)=$GET(APPACK("MFA",5))
+7 SET APPACK("MFA",6)=$GET(APPACK("MFA",6))
+8 SET APPACK("MFI",1,1)=$GET(APPACK("MFI",1,1))
+9 SET APPACK("MFI",1,2)=$GET(APPACK("MFI",1,2))
+10 SET APPACK("MFI",3)=$GET(APPACK("MFI",3))
+11 SET APPACK("MFI",6)=$GET(APPACK("MFI",6))
+12 SET APPACK("MSA",1)=$GET(APPACK("MSA",1))
+13 SET APPACK("MSA",2)=$GET(APPACK("MSA",2))
+14 QUIT
