FBFHLX ;WOIFO/SAB - TRANSMIT HL7 MESSAGES TO FPPS ;7/14/14 16:08
;;3.5;FEE BASIS;**61,121,122,154**;JUNE 6, 2011;Build 12
;;Per VA Directive 6402, this routine should not be modified.
Q
;
EN ; Entry Point
; may be called by scheduled option as non-interactive task
; may be called by user menu option as interactive task
;
N FBMODE,FBQUIT
S FBQUIT=0
;
; Determine Mode - (A)LL PENDING or BY SELECTED (I)NVOICE
I $E(IOST,1,2)'="C-" S FBMODE="A" ; non-interactive is always ALL
I $E(IOST,1,2)="C-" D
. I '$D(^XUSEC("FBAA LEVEL 2",DUZ)) W !!?3,$C(7)_"You must hold the FBAA LEVEL 2 security key to transmit messages." S FBQUIT=1 Q
. ; ask mode
. W !,"This option transmits HL7 messages to FPPS for EDI invoices."
. S DIR(0)="S^I:By Specified Invoice;A:All Pending Invoices"
. S DIR("A")="Select Transmission Option"
. S DIR("?",1)="Enter I to transmit a single invoice or A to transmit"
. S DIR("?",2)="all pending invoices. If I is entered then you will be"
. S DIR("?",3)="asked to select the invoice."
. S DIR("?",4)=""
. S DIR("?")="Enter a code from the list."
. D ^DIR K DIR I $D(DIRUT) S FBQUIT=1 Q
. S FBMODE=Y
. ; confirm all
. I FBMODE="A" D
. . S DIR(0)="Y",DIR("A")="Transmit all pending invoices now"
. . D ^DIR K DIR I 'Y!$D(DIRUT) S FBQUIT=1 Q
Q:FBQUIT
;
I FBMODE="A" D ALL
I FBMODE="I" D BYINV
;
Q
;
ALL ; Transmit All Pending Invoices (interactive and non-interactive)
; input
; FBQUIT - boolean value (0 or 1), true if process should stop
; output
; FBQUIT - may change value
;
N FBCNT,FBERR,FBHL,FBQDA,FBSTA,FBTTYP,FBXL,FBXMIT,FBFTRACK,HLFS,HLECH ; FB*3.5*122
;
; init
S FBXL=20 ; last line used for message text (save 20 lines for header)
S FBCNT("PENDT")=0 ; count of pending invoices that were transmitted
S FBCNT("PENDE")=0 ; count of pending invoices that had exception
;
; save time that process started
S FBXMIT("START")=$$NOW^XLFDT()
I $E(IOST,1,2)="C-" W !!,"Starting Process..."
D TIME^FBFHLX2("START",FBXMIT("START"),.FBFTRACK) I $G(FBFTRACK) Q ; active job to quit ; FB*3.5*122
;
; initialize HL variables
D INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
I $G(FBHL) D
. S FBQUIT=1
. D PTXT^FBFHLX1(.FBXL,"Error: Unable to initialize HL variables.")
. D PTXT^FBFHLX1(.FBXL,FBHL)
E D
. S HLFS=FBHL("FS")
. S HLECH=FBHL("ECH")
;
; check for transmitted invoices w/o commit ACK
S FBXMIT("ACK")=$$NOW^XLFDT()
I 'FBQUIT,$E(IOST,1,2)="C-" W !!,"Checking for acknowledgements..."
I 'FBQUIT D CHKACK^FBFHLX1
;
S FBXMIT("SEND")=$$NOW^XLFDT()
;
I 'FBQUIT,$E(IOST,1,2)="C-" W !!,"Transmitting Pending Invoices..."
; loop thru pending invoices and transmit
S FBQDA=0 F S FBQDA=$O(^FBHL(163.5,"AC",0,FBQDA)) Q:'FBQDA!FBQUIT D
. ; check for taskman quit request
. I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,FBQUIT=1 Q
. S ^XTMP("FBFHLX","IEN")=$H_U_FBQDA_"^XMIT^" ; FB*3.5*122
. ; try to transmit invoice
. D INVOICE
. ; update counters based on result
. I FBERR S FBCNT("PENDE")=FBCNT("PENDE")+1
. E S FBCNT("PENDT")=FBCNT("PENDT")+1
. I FBCNT("PENDE")+FBCNT("PENDT")>9999 S (FBCNT("10K"),FBQUIT)=1 ; FB*3.5*121
;
; save time that process ended
S FBXMIT("END")=$$NOW^XLFDT()
I $E(IOST,1,2)="C-" W !!,"Process complete. Sending Summary Message to G.FEE..."
D TIME^FBFHLX2("END",FBXMIT("END")) ; FB*3.5*121
;
; build and send summary mail message to G.FEE
D SUMMSG^FBFHLX1
;
; clean-up
K ^TMP($J,"FBE"),^TMP($J,"FBNA"),^TMP($J,"FBW"),^TMP($J,"FBX")
;
Q
;
BYINV ; Transmit Selected Invoices (interactive)
;
N FBAAIN,FBERR,FBHL,FBQDA,FBSTA,FBTTYP,FBX,HLFS,HLECH
;
; initialize HL variables
D INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
I $G(FBHL) D Q
. W !,$C(7),"ERROR: Couldn't initialize HL variables!"
. W !,FBHL
S HLFS=FBHL("FS")
S HLECH=FBHL("ECH")
;
; select invoice
F Q:FBQUIT D
. S DIC="^FBHL(163.5,",DIC(0)="AEQM"
. D ^DIC I Y'>0 S FBQUIT=1 Q
. S FBQDA=+Y
. ;
. ; get invoice number and switch to last entry for invoice
. S FBAAIN=$P($G(^FBHL(163.5,FBQDA,0)),U)
. S FBQDA=$$LAST^FBFHLU(FBAAIN)
. I 'FBQDA W !,"Error, invalid data for invoice ",FBAAIN," in file 163.5" Q
. S FBQY=$G(^FBHL(163.5,FBQDA,0))
. ;
. ; confirm
. S FBX=$S($P(FBQY,U,3)=0:"",1:"re-")
. S DIR(0)="Y"
. S DIR("A")="Do you want to "_FBX_"transmit invoice "_FBAAIN
. D ^DIR K DIR S:$D(DIRUT) FBQUIT=1 I 'Y Q
. ;
. ; if re-transmit then create a new pending entry for invoice
. I FBX="re-" D
. . D FILEQUE^FBFHLL(FBAAIN,$P(FBQY,U,2))
. . S FBQDA=$$LAST^FBFHLU(FBAAIN)
. . I FBQDA S FBQY=$G(^FBHL(163.5,FBQDA,0))
. . E S FBQY=""
. ;
. ; check that pending entry was added
. I FBX="re-",$P(FBQY,U,3)'=0 D Q
. . W !,"Error adding entry to file 163.5. Can't re-transmit invoice."
. ;
. ; transmit specified invoice
. D INVOICE
. ;
. ; report success or failure of transmit
. I FBERR=0 W !,"Invoice has been transmitted to the HL7 package.",!!
. I FBERR=1 D
. . N FBL
. . W $C(7),!,"Problems prevented transmission of the invoice."
. . S FBL=0 F S FBL=$O(^TMP($J,"FBE",FBAAIN,FBL)) Q:'FBL D
. . . W !," ",$G(^TMP($J,"FBE",FBAAIN,FBL))
. . W !
. ;
. ; clean up after transmit
. K ^TMP($J,"FBE",FBAAIN)
. K ^TMP($J,"FBW",FBAAIN)
;
Q
;
INVOICE ; transmit invoice
; input
; FBQDA - ien of entry in file 163.5 to transmit, required
; output
; FBERR - error flag (0 or 1), true if error prevented transmit
; FBSTA - station number in transmitted message (may be null if err)
; FBTTYP - transaction type in transmitted message (may be null)
; ^TMP($J,"FBE",invoice number,#) - any exceptions
; ^TMP($J,"FBW",invoice number,#) - any warnings
;
; N FBAAIN,FBD,FBFILE,FBRESULT,FBQY
;
; initialize
S FBERR=0
S FBSTA=""
S FBTTYP=""
;
; check for required input
I '$G(FBQDA) S FBERR=1 Q
;
; lock record
L +^FBHL(163.5,FBQDA):10
I '$T D Q
. S FBERR=1
. S FBAAIN=+$P($G(^FBHL(163.5,FBQDA,0)),U)
. I FBAAIN D POST^FBFHLU(FBAAIN,"E","Couldn't Lock Entry "_FBQDA_" in File 163.5.")
;
; get invoice number and file number
I 'FBERR D
. N FBQY
. S FBQY=$G(^FBHL(163.5,FBQDA,0))
. S FBAAIN=+$P(FBQY,U)
. I 'FBAAIN D
. . S FBERR=1
. . D POST^FBFHLU(0,"E","Couldn't determine invoice # for entry "_FBQDA_" in file 163.5.")
. Q:FBERR
. S FBFILE=$P(FBQY,U,2)
. I "^3^5^9^"'[(U_FBFILE_U) D
. . S FBERR=1
. . D POST^FBFHLU(FBAAIN,"E","Invalid File # for entry "_FBQDA_" in file 163.5.")
;
; gather invoice data
I 'FBERR D @("EN^FBFHLD"_FBFILE) I $D(^TMP($J,"FBE",FBAAIN)) S FBERR=1
S FBTTYP=$P($G(FBD(0,"INV")),U,2)
S FBSTA=$P($G(FBD(0,"INV")),U,3)
;
; build HL segments
I 'FBERR D EN^FBFHLS I $D(^TMP($J,"FBE",FBAAIN)) S FBERR=1
;
; generate HL message
I 'FBERR D
. K FBRESULT
. D GENERATE^HLMA("FB FEE TO FPPS EVENT","GM",1,.FBRESULT)
. I +$P(FBRESULT,U,2) D
. . S FBERR=1
. . D POST^FBFHLU(FBAAIN,"E","HL ERR:"_$P(FBRESULT,U,3))
;
; update file 163.5
I 'FBERR D
. N FBFDA
. S FBFDA(163.5,FBQDA_",",2)="1" ; set status = transmitted
. S FBFDA(163.5,FBQDA_",",3)=$P(FBRESULT,U) ; message ID
. S FBFDA(163.5,FBQDA_",",4)=$$NOW^XLFDT() ; message date/time
. S FBFDA(163.5,FBQDA_",",5)=FBTTYP ; transaction type
. S FBFDA(163.5,FBQDA_",",6)=FBSTA ; station number
. I $D(FBFDA) D FILE^DIE("","FBFDA")
. ;
. ; store HL segments in word-processing field
. D MOVEHL
. D WP^DIE(163.5,FBQDA_",",7,"","^TMP($J,""FBHLSEG"")")
. K ^TMP($J,"FBHLSEG")
;
; unlock record
L -^FBHL(163.5,FBQDA)
;
; clean-up
K ^TMP("HLS",$J)
Q
;
MOVEHL ; Copy HL segment data into word-processing style array
; input
; ^TMP("HLS",$J, array
; output
; ^TMP($J,"HLSEG",#)=line of text
; there will be a blank line after each segment
;
N FBI,FBII,FBL
K ^TMP($J,"FBHLSEG")
S FBL=0
S FBI=0 F S FBI=$O(^TMP("HLS",$J,FBI)) Q:'FBI D
. S FBL=FBL+1,^TMP($J,"FBHLSEG",FBL)=$G(^TMP("HLS",$J,FBI))
. S FBII=0 F S FBII=$O(^TMP("HLS",$J,FBI,FBII)) Q:'FBII D
. . S FBL=FBL+1,^TMP($J,"FBHLSEG",FBL)=$G(^TMP("HLS",$J,FBI,FBII))
. S FBL=FBL+1,^TMP($J,"FBHLSEG",FBL)=""
Q
;
;FBFHLX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFHLX 8231 printed Sep 23, 2025@19:34:29 Page 2
FBFHLX ;WOIFO/SAB - TRANSMIT HL7 MESSAGES TO FPPS ;7/14/14 16:08
+1 ;;3.5;FEE BASIS;**61,121,122,154**;JUNE 6, 2011;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EN ; Entry Point
+1 ; may be called by scheduled option as non-interactive task
+2 ; may be called by user menu option as interactive task
+3 ;
+4 NEW FBMODE,FBQUIT
+5 SET FBQUIT=0
+6 ;
+7 ; Determine Mode - (A)LL PENDING or BY SELECTED (I)NVOICE
+8 ; non-interactive is always ALL
IF $EXTRACT(IOST,1,2)'="C-"
SET FBMODE="A"
+9 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+10 IF '$DATA(^XUSEC("FBAA LEVEL 2",DUZ))
WRITE !!?3,$CHAR(7)_"You must hold the FBAA LEVEL 2 security key to transmit messages."
SET FBQUIT=1
QUIT
+11 ; ask mode
+12 WRITE !,"This option transmits HL7 messages to FPPS for EDI invoices."
+13 SET DIR(0)="S^I:By Specified Invoice;A:All Pending Invoices"
+14 SET DIR("A")="Select Transmission Option"
+15 SET DIR("?",1)="Enter I to transmit a single invoice or A to transmit"
+16 SET DIR("?",2)="all pending invoices. If I is entered then you will be"
+17 SET DIR("?",3)="asked to select the invoice."
+18 SET DIR("?",4)=""
+19 SET DIR("?")="Enter a code from the list."
+20 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBQUIT=1
QUIT
+21 SET FBMODE=Y
+22 ; confirm all
+23 IF FBMODE="A"
Begin DoDot:2
+24 SET DIR(0)="Y"
SET DIR("A")="Transmit all pending invoices now"
+25 DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
SET FBQUIT=1
QUIT
End DoDot:2
End DoDot:1
+26 if FBQUIT
QUIT
+27 ;
+28 IF FBMODE="A"
DO ALL
+29 IF FBMODE="I"
DO BYINV
+30 ;
+31 QUIT
+32 ;
ALL ; Transmit All Pending Invoices (interactive and non-interactive)
+1 ; input
+2 ; FBQUIT - boolean value (0 or 1), true if process should stop
+3 ; output
+4 ; FBQUIT - may change value
+5 ;
+6 ; FB*3.5*122
NEW FBCNT,FBERR,FBHL,FBQDA,FBSTA,FBTTYP,FBXL,FBXMIT,FBFTRACK,HLFS,HLECH
+7 ;
+8 ; init
+9 ; last line used for message text (save 20 lines for header)
SET FBXL=20
+10 ; count of pending invoices that were transmitted
SET FBCNT("PENDT")=0
+11 ; count of pending invoices that had exception
SET FBCNT("PENDE")=0
+12 ;
+13 ; save time that process started
+14 SET FBXMIT("START")=$$NOW^XLFDT()
+15 IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Starting Process..."
+16 ; active job to quit ; FB*3.5*122
DO TIME^FBFHLX2("START",FBXMIT("START"),.FBFTRACK)
IF $GET(FBFTRACK)
QUIT
+17 ;
+18 ; initialize HL variables
+19 DO INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
+20 IF $GET(FBHL)
Begin DoDot:1
+21 SET FBQUIT=1
+22 DO PTXT^FBFHLX1(.FBXL,"Error: Unable to initialize HL variables.")
+23 DO PTXT^FBFHLX1(.FBXL,FBHL)
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 SET HLFS=FBHL("FS")
+26 SET HLECH=FBHL("ECH")
End DoDot:1
+27 ;
+28 ; check for transmitted invoices w/o commit ACK
+29 SET FBXMIT("ACK")=$$NOW^XLFDT()
+30 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Checking for acknowledgements..."
+31 IF 'FBQUIT
DO CHKACK^FBFHLX1
+32 ;
+33 SET FBXMIT("SEND")=$$NOW^XLFDT()
+34 ;
+35 IF 'FBQUIT
IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Transmitting Pending Invoices..."
+36 ; loop thru pending invoices and transmit
+37 SET FBQDA=0
FOR
SET FBQDA=$ORDER(^FBHL(163.5,"AC",0,FBQDA))
if 'FBQDA!FBQUIT
QUIT
Begin DoDot:1
+38 ; check for taskman quit request
+39 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET FBQUIT=1
QUIT
+40 ; FB*3.5*122
SET ^XTMP("FBFHLX","IEN")=$HOROLOG_U_FBQDA_"^XMIT^"
+41 ; try to transmit invoice
+42 DO INVOICE
+43 ; update counters based on result
+44 IF FBERR
SET FBCNT("PENDE")=FBCNT("PENDE")+1
+45 IF '$TEST
SET FBCNT("PENDT")=FBCNT("PENDT")+1
+46 ; FB*3.5*121
IF FBCNT("PENDE")+FBCNT("PENDT")>9999
SET (FBCNT("10K"),FBQUIT)=1
End DoDot:1
+47 ;
+48 ; save time that process ended
+49 SET FBXMIT("END")=$$NOW^XLFDT()
+50 IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Process complete. Sending Summary Message to G.FEE..."
+51 ; FB*3.5*121
DO TIME^FBFHLX2("END",FBXMIT("END"))
+52 ;
+53 ; build and send summary mail message to G.FEE
+54 DO SUMMSG^FBFHLX1
+55 ;
+56 ; clean-up
+57 KILL ^TMP($JOB,"FBE"),^TMP($JOB,"FBNA"),^TMP($JOB,"FBW"),^TMP($JOB,"FBX")
+58 ;
+59 QUIT
+60 ;
BYINV ; Transmit Selected Invoices (interactive)
+1 ;
+2 NEW FBAAIN,FBERR,FBHL,FBQDA,FBSTA,FBTTYP,FBX,HLFS,HLECH
+3 ;
+4 ; initialize HL variables
+5 DO INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
+6 IF $GET(FBHL)
Begin DoDot:1
+7 WRITE !,$CHAR(7),"ERROR: Couldn't initialize HL variables!"
+8 WRITE !,FBHL
End DoDot:1
QUIT
+9 SET HLFS=FBHL("FS")
+10 SET HLECH=FBHL("ECH")
+11 ;
+12 ; select invoice
+13 FOR
if FBQUIT
QUIT
Begin DoDot:1
+14 SET DIC="^FBHL(163.5,"
SET DIC(0)="AEQM"
+15 DO ^DIC
IF Y'>0
SET FBQUIT=1
QUIT
+16 SET FBQDA=+Y
+17 ;
+18 ; get invoice number and switch to last entry for invoice
+19 SET FBAAIN=$PIECE($GET(^FBHL(163.5,FBQDA,0)),U)
+20 SET FBQDA=$$LAST^FBFHLU(FBAAIN)
+21 IF 'FBQDA
WRITE !,"Error, invalid data for invoice ",FBAAIN," in file 163.5"
QUIT
+22 SET FBQY=$GET(^FBHL(163.5,FBQDA,0))
+23 ;
+24 ; confirm
+25 SET FBX=$SELECT($PIECE(FBQY,U,3)=0:"",1:"re-")
+26 SET DIR(0)="Y"
+27 SET DIR("A")="Do you want to "_FBX_"transmit invoice "_FBAAIN
+28 DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET FBQUIT=1
IF 'Y
QUIT
+29 ;
+30 ; if re-transmit then create a new pending entry for invoice
+31 IF FBX="re-"
Begin DoDot:2
+32 DO FILEQUE^FBFHLL(FBAAIN,$PIECE(FBQY,U,2))
+33 SET FBQDA=$$LAST^FBFHLU(FBAAIN)
+34 IF FBQDA
SET FBQY=$GET(^FBHL(163.5,FBQDA,0))
+35 IF '$TEST
SET FBQY=""
End DoDot:2
+36 ;
+37 ; check that pending entry was added
+38 IF FBX="re-"
IF $PIECE(FBQY,U,3)'=0
Begin DoDot:2
+39 WRITE !,"Error adding entry to file 163.5. Can't re-transmit invoice."
End DoDot:2
QUIT
+40 ;
+41 ; transmit specified invoice
+42 DO INVOICE
+43 ;
+44 ; report success or failure of transmit
+45 IF FBERR=0
WRITE !,"Invoice has been transmitted to the HL7 package.",!!
+46 IF FBERR=1
Begin DoDot:2
+47 NEW FBL
+48 WRITE $CHAR(7),!,"Problems prevented transmission of the invoice."
+49 SET FBL=0
FOR
SET FBL=$ORDER(^TMP($JOB,"FBE",FBAAIN,FBL))
if 'FBL
QUIT
Begin DoDot:3
+50 WRITE !," ",$GET(^TMP($JOB,"FBE",FBAAIN,FBL))
End DoDot:3
+51 WRITE !
End DoDot:2
+52 ;
+53 ; clean up after transmit
+54 KILL ^TMP($JOB,"FBE",FBAAIN)
+55 KILL ^TMP($JOB,"FBW",FBAAIN)
End DoDot:1
+56 ;
+57 QUIT
+58 ;
INVOICE ; transmit invoice
+1 ; input
+2 ; FBQDA - ien of entry in file 163.5 to transmit, required
+3 ; output
+4 ; FBERR - error flag (0 or 1), true if error prevented transmit
+5 ; FBSTA - station number in transmitted message (may be null if err)
+6 ; FBTTYP - transaction type in transmitted message (may be null)
+7 ; ^TMP($J,"FBE",invoice number,#) - any exceptions
+8 ; ^TMP($J,"FBW",invoice number,#) - any warnings
+9 ;
+10 ; N FBAAIN,FBD,FBFILE,FBRESULT,FBQY
+11 ;
+12 ; initialize
+13 SET FBERR=0
+14 SET FBSTA=""
+15 SET FBTTYP=""
+16 ;
+17 ; check for required input
+18 IF '$GET(FBQDA)
SET FBERR=1
QUIT
+19 ;
+20 ; lock record
+21 LOCK +^FBHL(163.5,FBQDA):10
+22 IF '$TEST
Begin DoDot:1
+23 SET FBERR=1
+24 SET FBAAIN=+$PIECE($GET(^FBHL(163.5,FBQDA,0)),U)
+25 IF FBAAIN
DO POST^FBFHLU(FBAAIN,"E","Couldn't Lock Entry "_FBQDA_" in File 163.5.")
End DoDot:1
QUIT
+26 ;
+27 ; get invoice number and file number
+28 IF 'FBERR
Begin DoDot:1
+29 NEW FBQY
+30 SET FBQY=$GET(^FBHL(163.5,FBQDA,0))
+31 SET FBAAIN=+$PIECE(FBQY,U)
+32 IF 'FBAAIN
Begin DoDot:2
+33 SET FBERR=1
+34 DO POST^FBFHLU(0,"E","Couldn't determine invoice # for entry "_FBQDA_" in file 163.5.")
End DoDot:2
+35 if FBERR
QUIT
+36 SET FBFILE=$PIECE(FBQY,U,2)
+37 IF "^3^5^9^"'[(U_FBFILE_U)
Begin DoDot:2
+38 SET FBERR=1
+39 DO POST^FBFHLU(FBAAIN,"E","Invalid File # for entry "_FBQDA_" in file 163.5.")
End DoDot:2
End DoDot:1
+40 ;
+41 ; gather invoice data
+42 IF 'FBERR
DO @("EN^FBFHLD"_FBFILE)
IF $DATA(^TMP($JOB,"FBE",FBAAIN))
SET FBERR=1
+43 SET FBTTYP=$PIECE($GET(FBD(0,"INV")),U,2)
+44 SET FBSTA=$PIECE($GET(FBD(0,"INV")),U,3)
+45 ;
+46 ; build HL segments
+47 IF 'FBERR
DO EN^FBFHLS
IF $DATA(^TMP($JOB,"FBE",FBAAIN))
SET FBERR=1
+48 ;
+49 ; generate HL message
+50 IF 'FBERR
Begin DoDot:1
+51 KILL FBRESULT
+52 DO GENERATE^HLMA("FB FEE TO FPPS EVENT","GM",1,.FBRESULT)
+53 IF +$PIECE(FBRESULT,U,2)
Begin DoDot:2
+54 SET FBERR=1
+55 DO POST^FBFHLU(FBAAIN,"E","HL ERR:"_$PIECE(FBRESULT,U,3))
End DoDot:2
End DoDot:1
+56 ;
+57 ; update file 163.5
+58 IF 'FBERR
Begin DoDot:1
+59 NEW FBFDA
+60 ; set status = transmitted
SET FBFDA(163.5,FBQDA_",",2)="1"
+61 ; message ID
SET FBFDA(163.5,FBQDA_",",3)=$PIECE(FBRESULT,U)
+62 ; message date/time
SET FBFDA(163.5,FBQDA_",",4)=$$NOW^XLFDT()
+63 ; transaction type
SET FBFDA(163.5,FBQDA_",",5)=FBTTYP
+64 ; station number
SET FBFDA(163.5,FBQDA_",",6)=FBSTA
+65 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+66 ;
+67 ; store HL segments in word-processing field
+68 DO MOVEHL
+69 DO WP^DIE(163.5,FBQDA_",",7,"","^TMP($J,""FBHLSEG"")")
+70 KILL ^TMP($JOB,"FBHLSEG")
End DoDot:1
+71 ;
+72 ; unlock record
+73 LOCK -^FBHL(163.5,FBQDA)
+74 ;
+75 ; clean-up
+76 KILL ^TMP("HLS",$JOB)
+77 QUIT
+78 ;
MOVEHL ; Copy HL segment data into word-processing style array
+1 ; input
+2 ; ^TMP("HLS",$J, array
+3 ; output
+4 ; ^TMP($J,"HLSEG",#)=line of text
+5 ; there will be a blank line after each segment
+6 ;
+7 NEW FBI,FBII,FBL
+8 KILL ^TMP($JOB,"FBHLSEG")
+9 SET FBL=0
+10 SET FBI=0
FOR
SET FBI=$ORDER(^TMP("HLS",$JOB,FBI))
if 'FBI
QUIT
Begin DoDot:1
+11 SET FBL=FBL+1
SET ^TMP($JOB,"FBHLSEG",FBL)=$GET(^TMP("HLS",$JOB,FBI))
+12 SET FBII=0
FOR
SET FBII=$ORDER(^TMP("HLS",$JOB,FBI,FBII))
if 'FBII
QUIT
Begin DoDot:2
+13 SET FBL=FBL+1
SET ^TMP($JOB,"FBHLSEG",FBL)=$GET(^TMP("HLS",$JOB,FBI,FBII))
End DoDot:2
+14 SET FBL=FBL+1
SET ^TMP($JOB,"FBHLSEG",FBL)=""
End DoDot:1
+15 QUIT
+16 ;
+17 ;FBFHLX
