- 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 Dec 13, 2024@01:58:25 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