FBFHLS ;OIFO/SAB-BUILD HL7 MESSAGE SEGMENTS ;11/21/2003
;;3.5;FEE BASIS;**61,68,122**;JUNE 6, 2011;Build 8
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
EN ;
; input
; HLFS - HL7 field separator
; HLECH - HL7 encoding characters
; FBAAIN - invoice number
; FBD( array containing the invoice data
; Applicablity of a FBD node for a given transaction type (C,L, or X)
; is indicated by the presence of the transaction type code at the
; beginning of the line in the following table.
;
; Claim Level Data
; CL FBD(0,"AMT") = Amount Disbursed^Amount Interest
; X FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
; C FBD(0,"DAYS") = Covered Days
; C FBD(0,"DRG") = DRG Code^DRG Weight
; CL FBD(0,"DT") = Invoice Date
; CLX FBD(0,"FPPS") = FPPS Claim ID
; CLX FBD(0,"INV") = Invoice #^Transaction Type^Station #
;
; Line Level Data (# is a sequential number)
; CL FBD(#,"ADJ") = AdjReas1^AdjGrp1^AdjAmt1^AdjReas2^AdjGrp2^AdjAmt2
; note: ADJ node is only defined when there is an adjustment
; note: only 1 adjustment for C type
; CL FBD(#,"AMT") = Amount Claimed^Amount Paid
; CL FBD(#,"CK") = Check Number^Check Date^Payment Method
; CL FBD(#,"835") = Routing Number^Account Number^Financial Institution FB*3.5*122
; CL FBD(#,"DT") = Date of Service/Start Date^End Date
; note: End Date only applicable for C type
; CL FBD(#,"FPPS") = FPPS Line Item
; CL FBD(#,"RMK") = Remittance Remark1,Remittance Remark2
; L FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
; note: SVC node is not defined for pharmacy invoices
;
; If existing exceptions for invoice
; ^TMP($J,"FBE",FBAAIN,seq number)=message
; If existing warnings for invoice
; ^TMP($J,"FBW",FBAAIN,seq number)=message
;
; output
; ^TMP("HLS",$J) = HL global array for invoice
; If new exceptions for invoice
; ^TMP($J,"FBE",FBAAIN,seq number)=message
; If new warnings for invoice
; ^TMP($J,"FBW",FBAAIN,seq number)=message
;
; initialize variables
N FBTTYP
K ^TMP("HLS",$J)
;
; determine transaction type
S FBTTYP=$P($G(FBD(0,"INV")),U,2)
;
I '$D(HLFS) D I '$D(HLFS) Q
. N FBHL
. D INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
. I $G(FBHL) Q
. S HLFS=FBHL("FS")
. S HLECH=FBHL("ECH")
;
; check for required fields
D CHKREQ^FBFHLS1
;
; quit if exceptions
Q:$D(^TMP($J,"FBE",FBAAIN))
;
; build segments for invoice in ^TMP("HLS",$J,
I FBTTYP="C" D CL
I FBTTYP="L" D CL
I FBTTYP="X" D X
;
Q
;
CL ; Claim or Line Transaction
N FBCOMP,FBFLD,FBFT1,FBI,FBL,FBORC,FBX
S FBL=0 ; line counter for HL7 lines in ^TMP("HLS",$J,line
; loop thru line items (Claim Transaction must have just 1 line)
S FBI=0 F S FBI=$O(FBD(FBI)) Q:'FBI D
. S FBORC="ORC"
. ; transaction type (005)
. S $P(FBORC,HLFS,6)=$P(FBD(0,"INV"),U,2)
. ;
. I FBTTYP="C" D
. . ; covered days (007.3)
. . S FBFLD=$P(FBORC,HLFS,8)
. . S $P(FBFLD,$E(HLECH,1),3)=$P(FBD(0,"DAYS"),U)
. . S $P(FBORC,HLFS,8)=FBFLD
. ;
. ; date of service/start date (007.4.1)
. S FBFLD=$P(FBORC,HLFS,8)
. S FBCOMP=$P(FBFLD,$E(HLECH,1),4)
. S $P(FBCOMP,$E(HLECH,2),1)=$$FMTHL7^XLFDT($P(FBD(FBI,"DT"),U))
. S $P(FBFLD,$E(HLECH,1),4)=FBCOMP
. S $P(FBORC,HLFS,8)=FBFLD
. ;
. I FBTTYP="C" D
. . ; end date (007.5.1)
. . S FBFLD=$P(FBORC,HLFS,8)
. . S FBCOMP=$P(FBFLD,$E(HLECH,1),5)
. . S $P(FBCOMP,$E(HLECH,2),1)=$$FMTHL7^XLFDT($P(FBD(FBI,"DT"),U,2))
. . S $P(FBFLD,$E(HLECH,1),5)=FBCOMP
. . S $P(FBORC,HLFS,8)=FBFLD
. ;
. ; invoice date (009.1)
. S FBFLD=$P(FBORC,HLFS,10)
. S $P(FBFLD,$E(HLECH,1),1)=$$FMTHL7^XLFDT($P(FBD(0,"DT"),U))
. S $P(FBORC,HLFS,10)=FBFLD
. ;
. ; station number (013.4.2)
. S FBFLD=$P(FBORC,HLFS,14)
. S FBCOMP=$P(FBFLD,$E(HLECH,1),4)
. S $P(FBCOMP,$E(HLECH,2),2)=$P(FBD(0,"INV"),U,3)
. S $P(FBFLD,$E(HLECH,1),4)=FBCOMP
. S $P(FBORC,HLFS,14)=FBFLD
. ;
. ; store HL ORC segment for the line item
. S FBX=FBORC D TMPHL
. ;
. S FBFT1="FT1"
. ;
. ; FPPS CLAIM-LINE (002)
. S $P(FBFT1,HLFS,3)=$P(FBD(0,"FPPS"),U)_"-"_$$EXPLIST($P(FBD(FBI,"FPPS"),U))
. ;
. ; INVOICE # (003)
. S $P(FBFT1,HLFS,4)=$P(FBD(0,"INV"),U)
. ;
. ; CHECK DATE (004)
. S $P(FBFT1,HLFS,5)=$$FMTHL7^XLFDT($P(FBD(FBI,"CK"),U,2))
. ;
. ; PAYMENT METHOD (006)
. S $P(FBFT1,HLFS,7)=$P(FBD(FBI,"CK"),U,3)
. ;
. I FBTTYP="L" D
. . ; UNITS PAID (010)
. . S $P(FBFT1,HLFS,11)=$P($G(FBD(FBI,"SVC")),U,4)
. ;
. ; REMITTANCE REMARKS (013)
. S $P(FBFT1,HLFS,14)=$P(FBD(FBI,"RMK"),U)
. ;
. I FBTTYP="L" D
. . ; SERVICE QUALIFIER (019)
. . S $P(FBFT1,HLFS,20)=$P($G(FBD(FBI,"SVC")),U,2)
. ;
. ; CHECK NUMBER (023)
. S $P(FBFT1,HLFS,24)=$P(FBD(FBI,"CK"),U)
. ;
. I FBTTYP="L" D
. . ; SERVICE PROVIDED (025)
. . S $P(FBFT1,HLFS,26)=$P($G(FBD(FBI,"SVC")),U)
. ;
. I FBTTYP="C" D
. . ; DRG (025)
. . S $P(FBFT1,HLFS,26)=$P(FBD(0,"DRG"),U)
. ;
. I FBTTYP="L" D
. . ; MODIFIERS (026)
. . S $P(FBFT1,HLFS,27)=$P($G(FBD(FBI,"SVC")),U,3)
. ;
. I FBTTYP="C" D
. . ; DRG WEIGHT (026)
. . S $P(FBFT1,HLFS,27)=$P(FBD(0,"DRG"),U,2)
. ;
. ; 835 (030) FB*3.5*122
. I $G(FBD(FBI,"835")) D S $P(FBFT1,HLFS,31)=FBD(FBI,"835",1)_FBD(FBI,"835",2)_FBD(FBI,"835",3)
.. S FBD(FBI,"835",1)=$P(FBD(FBI,"835"),U)
.. S $P(FBD(FBI,"835",2),$E(HLECH),8)=$E(HLECH)_$P(FBD(FBI,"835"),U,2)
.. S FBD(FBI,"835",3)=$E(HLECH,4)_$P(FBD(FBI,"835"),U,3)
. ;
. ; generate and store FT1s for each of the different $ amounts
. ; amount claimed
. S FBX=$$FT1(1,$P(FBD(FBI,"AMT"),U)) D TMPHL
. ; amount paid
. S FBX=$$FT1(2,$P(FBD(FBI,"AMT"),U,2)) D TMPHL
. ; interest amount (conditional)
. I $P(FBD(0,"AMT"),U,2)>0 S FBX=$$FT1(3,$P(FBD(0,"AMT"),U,2)) D TMPHL
. ; disbursed amount
. S FBX=$$FT1(4,$P(FBD(0,"AMT"),U)) D TMPHL
. ; adjustment amount 1 (conditional)
. I +$P($G(FBD(FBI,"ADJ")),U,3)'=0 S FBX=$$FT1(5,$P(FBD(FBI,"ADJ"),U,1,3)) D TMPHL
. I FBTTYP="L" D
. . ; adjustment amount 2 (conditional)
. . I +$P($G(FBD(FBI,"ADJ")),U,6)'=0 S FBX=$$FT1(5,$P(FBD(FBI,"ADJ"),U,4,6)) D TMPHL
;
Q
;
X ; Cancel Transaction
N FBCOMP,FBFLD,FBFT1,FBL,FBORC
S FBL=0 ; line counter for HL7 lines in ^TMP("HLS",$J,line
S FBORC="ORC"
; transaction type (005)
S $P(FBORC,HLFS,6)=$P(FBD(0,"INV"),U,2)
;
; cancel date (009.1)
S FBFLD=$P(FBORC,HLFS,10)
S $P(FBFLD,$E(HLECH,1),1)=$$FMTHL7^XLFDT($P(FBD(0,"CAN"),U))
S $P(FBORC,HLFS,10)=FBFLD
;
; station number (013.4.2)
S FBFLD=$P(FBORC,HLFS,14)
S FBCOMP=$P(FBFLD,$E(HLECH,1),4)
S $P(FBCOMP,$E(HLECH,2),2)=$P(FBD(0,"INV"),U,3)
S $P(FBFLD,$E(HLECH,1),4)=FBCOMP
S $P(FBORC,HLFS,14)=FBFLD
;
S FBFT1="FT1"
;
; FPPS CLAIM (002)
S $P(FBFT1,HLFS,3)=$P(FBD(0,"FPPS"),U)
;
; INVOICE # (003)
S $P(FBFT1,HLFS,4)=$P(FBD(0,"INV"),U)
;
; CANCEL ACTIVITY CODE (006)
S $P(FBFT1,HLFS,7)="F"_$P(FBD(0,"CAN"),U,3)
;
; CANCEL REASON (017)
S $P(FBFT1,HLFS,18)=$P(FBD(0,"CAN"),U,2)
;
; store HL segments for line item
S FBX=FBORC D TMPHL
S FBX=FBFT1 D TMPHL
;
Q
;
EXPLIST(FBLIST) ; expand ranges in a list
; input FBIST - list or range or "ALL"
; result expanded list (e.g. "1-3" returned as "1,2,3")
;
N FBER,FBRET,FBLIST2,FBI,FBX,FBY
S FBRET=$G(FBLIST)
I FBRET["-" D
. S FBLIST2="" ; init new list
. ; loop thru comma pieces in original list
. F FBI=1:1 S FBX=$P(FBLIST,",",FBI) Q:FBX="" D
. . I FBX'["-" S FBLIST2=FBLIST2_FBX_"," Q ; not range - put in new
. . ; expand range then put in new
. . S FBER=""
. . F FBY=$P(FBX,"-"):1:$P(FBX,"-",2) S FBER=FBER_FBY_","
. . ; append expanded range to new list
. . S FBLIST2=FBLIST2_FBER
. ; replace return value with expanded list
. S FBRET=FBLIST2
;
; remove trailing comma
I $E(FBRET,$L(FBRET))="," S FBRET=$E(FBRET,1,$L(FBRET)-1)
;
Q FBRET
;
FT1(FBTYAMT,FBX) ; add amount to FT1 segment
; input
; FBTYAMT - type of amount (1,2,3,4,5)
; FBX - if type 1-4 then amount
; - if type 5 then adj reason^adjustment group^adj amount
; FBFT1 - FT1 segment without an amount
; result (string)
; FT1 segment with amount (and reason, group) inserted
N FBRET
S FBRET=FBFT1
;
; TYPE AMOUNT (007)
S $P(FBRET,HLFS,8)=FBTYAMT
;
; AMOUNT (011)
I FBTYAMT<5 S $P(FBRET,HLFS,12)=$FN($P(FBX,U),"",2)
I FBTYAMT=5 S $P(FBRET,HLFS,12)=$FN($P(FBX,U,3),"",2)
;
; ADJUSTMENT REASON (017)
I FBTYAMT=5 S $P(FBRET,HLFS,18)=$P(FBX,U)
;
; ADJUSTMENT GROUP (018)
I FBTYAMT=5 S $P(FBRET,HLFS,19)=$P(FBX,U,2)
;
Q FBRET
;
TMPHL ; Place HL7 segment in ^TMP
; input
; FBL - last line written to ^TMP
; FBX - HL7 segment
; output
; FBL - will be incremented by 1
; stores FBX in ^TMP("HLS",$J,FBL+1)
; if length of FBX exceeds 244 then continuation lines will be used
; example ^TMP($J,"HLS",$J,FBL+1,1)
N FBLS
S FBL=FBL+1
I $L(FBX)<245 S ^TMP("HLS",$J,FBL)=FBX Q
S ^TMP("HLS",$J,FBL)=$E(FBX,1,244)
F FBLS=1:1 Q:$E(FBX,(FBLS*244)+1,(FBLS*244)+244)="" D
. S ^TMP("HLS",$J,FBL,FBLS)=$E(FBX,(FBLS*244)+1,(FBLS*244)+244)
Q
;
;FBFHLS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFHLS 9230 printed Dec 13, 2024@01:58:22 Page 2
FBFHLS ;OIFO/SAB-BUILD HL7 MESSAGE SEGMENTS ;11/21/2003
+1 ;;3.5;FEE BASIS;**61,68,122**;JUNE 6, 2011;Build 8
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
EN ;
+1 ; input
+2 ; HLFS - HL7 field separator
+3 ; HLECH - HL7 encoding characters
+4 ; FBAAIN - invoice number
+5 ; FBD( array containing the invoice data
+6 ; Applicablity of a FBD node for a given transaction type (C,L, or X)
+7 ; is indicated by the presence of the transaction type code at the
+8 ; beginning of the line in the following table.
+9 ;
+10 ; Claim Level Data
+11 ; CL FBD(0,"AMT") = Amount Disbursed^Amount Interest
+12 ; X FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
+13 ; C FBD(0,"DAYS") = Covered Days
+14 ; C FBD(0,"DRG") = DRG Code^DRG Weight
+15 ; CL FBD(0,"DT") = Invoice Date
+16 ; CLX FBD(0,"FPPS") = FPPS Claim ID
+17 ; CLX FBD(0,"INV") = Invoice #^Transaction Type^Station #
+18 ;
+19 ; Line Level Data (# is a sequential number)
+20 ; CL FBD(#,"ADJ") = AdjReas1^AdjGrp1^AdjAmt1^AdjReas2^AdjGrp2^AdjAmt2
+21 ; note: ADJ node is only defined when there is an adjustment
+22 ; note: only 1 adjustment for C type
+23 ; CL FBD(#,"AMT") = Amount Claimed^Amount Paid
+24 ; CL FBD(#,"CK") = Check Number^Check Date^Payment Method
+25 ; CL FBD(#,"835") = Routing Number^Account Number^Financial Institution FB*3.5*122
+26 ; CL FBD(#,"DT") = Date of Service/Start Date^End Date
+27 ; note: End Date only applicable for C type
+28 ; CL FBD(#,"FPPS") = FPPS Line Item
+29 ; CL FBD(#,"RMK") = Remittance Remark1,Remittance Remark2
+30 ; L FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
+31 ; note: SVC node is not defined for pharmacy invoices
+32 ;
+33 ; If existing exceptions for invoice
+34 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
+35 ; If existing warnings for invoice
+36 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
+37 ;
+38 ; output
+39 ; ^TMP("HLS",$J) = HL global array for invoice
+40 ; If new exceptions for invoice
+41 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
+42 ; If new warnings for invoice
+43 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
+44 ;
+45 ; initialize variables
+46 NEW FBTTYP
+47 KILL ^TMP("HLS",$JOB)
+48 ;
+49 ; determine transaction type
+50 SET FBTTYP=$PIECE($GET(FBD(0,"INV")),U,2)
+51 ;
+52 IF '$DATA(HLFS)
Begin DoDot:1
+53 NEW FBHL
+54 DO INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
+55 IF $GET(FBHL)
QUIT
+56 SET HLFS=FBHL("FS")
+57 SET HLECH=FBHL("ECH")
End DoDot:1
IF '$DATA(HLFS)
QUIT
+58 ;
+59 ; check for required fields
+60 DO CHKREQ^FBFHLS1
+61 ;
+62 ; quit if exceptions
+63 if $DATA(^TMP($JOB,"FBE",FBAAIN))
QUIT
+64 ;
+65 ; build segments for invoice in ^TMP("HLS",$J,
+66 IF FBTTYP="C"
DO CL
+67 IF FBTTYP="L"
DO CL
+68 IF FBTTYP="X"
DO X
+69 ;
+70 QUIT
+71 ;
CL ; Claim or Line Transaction
+1 NEW FBCOMP,FBFLD,FBFT1,FBI,FBL,FBORC,FBX
+2 ; line counter for HL7 lines in ^TMP("HLS",$J,line
SET FBL=0
+3 ; loop thru line items (Claim Transaction must have just 1 line)
+4 SET FBI=0
FOR
SET FBI=$ORDER(FBD(FBI))
if 'FBI
QUIT
Begin DoDot:1
+5 SET FBORC="ORC"
+6 ; transaction type (005)
+7 SET $PIECE(FBORC,HLFS,6)=$PIECE(FBD(0,"INV"),U,2)
+8 ;
+9 IF FBTTYP="C"
Begin DoDot:2
+10 ; covered days (007.3)
+11 SET FBFLD=$PIECE(FBORC,HLFS,8)
+12 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),3)=$PIECE(FBD(0,"DAYS"),U)
+13 SET $PIECE(FBORC,HLFS,8)=FBFLD
End DoDot:2
+14 ;
+15 ; date of service/start date (007.4.1)
+16 SET FBFLD=$PIECE(FBORC,HLFS,8)
+17 SET FBCOMP=$PIECE(FBFLD,$EXTRACT(HLECH,1),4)
+18 SET $PIECE(FBCOMP,$EXTRACT(HLECH,2),1)=$$FMTHL7^XLFDT($PIECE(FBD(FBI,"DT"),U))
+19 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),4)=FBCOMP
+20 SET $PIECE(FBORC,HLFS,8)=FBFLD
+21 ;
+22 IF FBTTYP="C"
Begin DoDot:2
+23 ; end date (007.5.1)
+24 SET FBFLD=$PIECE(FBORC,HLFS,8)
+25 SET FBCOMP=$PIECE(FBFLD,$EXTRACT(HLECH,1),5)
+26 SET $PIECE(FBCOMP,$EXTRACT(HLECH,2),1)=$$FMTHL7^XLFDT($PIECE(FBD(FBI,"DT"),U,2))
+27 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),5)=FBCOMP
+28 SET $PIECE(FBORC,HLFS,8)=FBFLD
End DoDot:2
+29 ;
+30 ; invoice date (009.1)
+31 SET FBFLD=$PIECE(FBORC,HLFS,10)
+32 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),1)=$$FMTHL7^XLFDT($PIECE(FBD(0,"DT"),U))
+33 SET $PIECE(FBORC,HLFS,10)=FBFLD
+34 ;
+35 ; station number (013.4.2)
+36 SET FBFLD=$PIECE(FBORC,HLFS,14)
+37 SET FBCOMP=$PIECE(FBFLD,$EXTRACT(HLECH,1),4)
+38 SET $PIECE(FBCOMP,$EXTRACT(HLECH,2),2)=$PIECE(FBD(0,"INV"),U,3)
+39 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),4)=FBCOMP
+40 SET $PIECE(FBORC,HLFS,14)=FBFLD
+41 ;
+42 ; store HL ORC segment for the line item
+43 SET FBX=FBORC
DO TMPHL
+44 ;
+45 SET FBFT1="FT1"
+46 ;
+47 ; FPPS CLAIM-LINE (002)
+48 SET $PIECE(FBFT1,HLFS,3)=$PIECE(FBD(0,"FPPS"),U)_"-"_$$EXPLIST($PIECE(FBD(FBI,"FPPS"),U))
+49 ;
+50 ; INVOICE # (003)
+51 SET $PIECE(FBFT1,HLFS,4)=$PIECE(FBD(0,"INV"),U)
+52 ;
+53 ; CHECK DATE (004)
+54 SET $PIECE(FBFT1,HLFS,5)=$$FMTHL7^XLFDT($PIECE(FBD(FBI,"CK"),U,2))
+55 ;
+56 ; PAYMENT METHOD (006)
+57 SET $PIECE(FBFT1,HLFS,7)=$PIECE(FBD(FBI,"CK"),U,3)
+58 ;
+59 IF FBTTYP="L"
Begin DoDot:2
+60 ; UNITS PAID (010)
+61 SET $PIECE(FBFT1,HLFS,11)=$PIECE($GET(FBD(FBI,"SVC")),U,4)
End DoDot:2
+62 ;
+63 ; REMITTANCE REMARKS (013)
+64 SET $PIECE(FBFT1,HLFS,14)=$PIECE(FBD(FBI,"RMK"),U)
+65 ;
+66 IF FBTTYP="L"
Begin DoDot:2
+67 ; SERVICE QUALIFIER (019)
+68 SET $PIECE(FBFT1,HLFS,20)=$PIECE($GET(FBD(FBI,"SVC")),U,2)
End DoDot:2
+69 ;
+70 ; CHECK NUMBER (023)
+71 SET $PIECE(FBFT1,HLFS,24)=$PIECE(FBD(FBI,"CK"),U)
+72 ;
+73 IF FBTTYP="L"
Begin DoDot:2
+74 ; SERVICE PROVIDED (025)
+75 SET $PIECE(FBFT1,HLFS,26)=$PIECE($GET(FBD(FBI,"SVC")),U)
End DoDot:2
+76 ;
+77 IF FBTTYP="C"
Begin DoDot:2
+78 ; DRG (025)
+79 SET $PIECE(FBFT1,HLFS,26)=$PIECE(FBD(0,"DRG"),U)
End DoDot:2
+80 ;
+81 IF FBTTYP="L"
Begin DoDot:2
+82 ; MODIFIERS (026)
+83 SET $PIECE(FBFT1,HLFS,27)=$PIECE($GET(FBD(FBI,"SVC")),U,3)
End DoDot:2
+84 ;
+85 IF FBTTYP="C"
Begin DoDot:2
+86 ; DRG WEIGHT (026)
+87 SET $PIECE(FBFT1,HLFS,27)=$PIECE(FBD(0,"DRG"),U,2)
End DoDot:2
+88 ;
+89 ; 835 (030) FB*3.5*122
+90 IF $GET(FBD(FBI,"835"))
Begin DoDot:2
+91 SET FBD(FBI,"835",1)=$PIECE(FBD(FBI,"835"),U)
+92 SET $PIECE(FBD(FBI,"835",2),$EXTRACT(HLECH),8)=$EXTRACT(HLECH)_$PIECE(FBD(FBI,"835"),U,2)
+93 SET FBD(FBI,"835",3)=$EXTRACT(HLECH,4)_$PIECE(FBD(FBI,"835"),U,3)
End DoDot:2
SET $PIECE(FBFT1,HLFS,31)=FBD(FBI,"835",1)_FBD(FBI,"835",2)_FBD(FBI,"835",3)
+94 ;
+95 ; generate and store FT1s for each of the different $ amounts
+96 ; amount claimed
+97 SET FBX=$$FT1(1,$PIECE(FBD(FBI,"AMT"),U))
DO TMPHL
+98 ; amount paid
+99 SET FBX=$$FT1(2,$PIECE(FBD(FBI,"AMT"),U,2))
DO TMPHL
+100 ; interest amount (conditional)
+101 IF $PIECE(FBD(0,"AMT"),U,2)>0
SET FBX=$$FT1(3,$PIECE(FBD(0,"AMT"),U,2))
DO TMPHL
+102 ; disbursed amount
+103 SET FBX=$$FT1(4,$PIECE(FBD(0,"AMT"),U))
DO TMPHL
+104 ; adjustment amount 1 (conditional)
+105 IF +$PIECE($GET(FBD(FBI,"ADJ")),U,3)'=0
SET FBX=$$FT1(5,$PIECE(FBD(FBI,"ADJ"),U,1,3))
DO TMPHL
+106 IF FBTTYP="L"
Begin DoDot:2
+107 ; adjustment amount 2 (conditional)
+108 IF +$PIECE($GET(FBD(FBI,"ADJ")),U,6)'=0
SET FBX=$$FT1(5,$PIECE(FBD(FBI,"ADJ"),U,4,6))
DO TMPHL
End DoDot:2
End DoDot:1
+109 ;
+110 QUIT
+111 ;
X ; Cancel Transaction
+1 NEW FBCOMP,FBFLD,FBFT1,FBL,FBORC
+2 ; line counter for HL7 lines in ^TMP("HLS",$J,line
SET FBL=0
+3 SET FBORC="ORC"
+4 ; transaction type (005)
+5 SET $PIECE(FBORC,HLFS,6)=$PIECE(FBD(0,"INV"),U,2)
+6 ;
+7 ; cancel date (009.1)
+8 SET FBFLD=$PIECE(FBORC,HLFS,10)
+9 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),1)=$$FMTHL7^XLFDT($PIECE(FBD(0,"CAN"),U))
+10 SET $PIECE(FBORC,HLFS,10)=FBFLD
+11 ;
+12 ; station number (013.4.2)
+13 SET FBFLD=$PIECE(FBORC,HLFS,14)
+14 SET FBCOMP=$PIECE(FBFLD,$EXTRACT(HLECH,1),4)
+15 SET $PIECE(FBCOMP,$EXTRACT(HLECH,2),2)=$PIECE(FBD(0,"INV"),U,3)
+16 SET $PIECE(FBFLD,$EXTRACT(HLECH,1),4)=FBCOMP
+17 SET $PIECE(FBORC,HLFS,14)=FBFLD
+18 ;
+19 SET FBFT1="FT1"
+20 ;
+21 ; FPPS CLAIM (002)
+22 SET $PIECE(FBFT1,HLFS,3)=$PIECE(FBD(0,"FPPS"),U)
+23 ;
+24 ; INVOICE # (003)
+25 SET $PIECE(FBFT1,HLFS,4)=$PIECE(FBD(0,"INV"),U)
+26 ;
+27 ; CANCEL ACTIVITY CODE (006)
+28 SET $PIECE(FBFT1,HLFS,7)="F"_$PIECE(FBD(0,"CAN"),U,3)
+29 ;
+30 ; CANCEL REASON (017)
+31 SET $PIECE(FBFT1,HLFS,18)=$PIECE(FBD(0,"CAN"),U,2)
+32 ;
+33 ; store HL segments for line item
+34 SET FBX=FBORC
DO TMPHL
+35 SET FBX=FBFT1
DO TMPHL
+36 ;
+37 QUIT
+38 ;
EXPLIST(FBLIST) ; expand ranges in a list
+1 ; input FBIST - list or range or "ALL"
+2 ; result expanded list (e.g. "1-3" returned as "1,2,3")
+3 ;
+4 NEW FBER,FBRET,FBLIST2,FBI,FBX,FBY
+5 SET FBRET=$GET(FBLIST)
+6 IF FBRET["-"
Begin DoDot:1
+7 ; init new list
SET FBLIST2=""
+8 ; loop thru comma pieces in original list
+9 FOR FBI=1:1
SET FBX=$PIECE(FBLIST,",",FBI)
if FBX=""
QUIT
Begin DoDot:2
+10 ; not range - put in new
IF FBX'["-"
SET FBLIST2=FBLIST2_FBX_","
QUIT
+11 ; expand range then put in new
+12 SET FBER=""
+13 FOR FBY=$PIECE(FBX,"-"):1:$PIECE(FBX,"-",2)
SET FBER=FBER_FBY_","
+14 ; append expanded range to new list
+15 SET FBLIST2=FBLIST2_FBER
End DoDot:2
+16 ; replace return value with expanded list
+17 SET FBRET=FBLIST2
End DoDot:1
+18 ;
+19 ; remove trailing comma
+20 IF $EXTRACT(FBRET,$LENGTH(FBRET))=","
SET FBRET=$EXTRACT(FBRET,1,$LENGTH(FBRET)-1)
+21 ;
+22 QUIT FBRET
+23 ;
FT1(FBTYAMT,FBX) ; add amount to FT1 segment
+1 ; input
+2 ; FBTYAMT - type of amount (1,2,3,4,5)
+3 ; FBX - if type 1-4 then amount
+4 ; - if type 5 then adj reason^adjustment group^adj amount
+5 ; FBFT1 - FT1 segment without an amount
+6 ; result (string)
+7 ; FT1 segment with amount (and reason, group) inserted
+8 NEW FBRET
+9 SET FBRET=FBFT1
+10 ;
+11 ; TYPE AMOUNT (007)
+12 SET $PIECE(FBRET,HLFS,8)=FBTYAMT
+13 ;
+14 ; AMOUNT (011)
+15 IF FBTYAMT<5
SET $PIECE(FBRET,HLFS,12)=$FNUMBER($PIECE(FBX,U),"",2)
+16 IF FBTYAMT=5
SET $PIECE(FBRET,HLFS,12)=$FNUMBER($PIECE(FBX,U,3),"",2)
+17 ;
+18 ; ADJUSTMENT REASON (017)
+19 IF FBTYAMT=5
SET $PIECE(FBRET,HLFS,18)=$PIECE(FBX,U)
+20 ;
+21 ; ADJUSTMENT GROUP (018)
+22 IF FBTYAMT=5
SET $PIECE(FBRET,HLFS,19)=$PIECE(FBX,U,2)
+23 ;
+24 QUIT FBRET
+25 ;
TMPHL ; Place HL7 segment in ^TMP
+1 ; input
+2 ; FBL - last line written to ^TMP
+3 ; FBX - HL7 segment
+4 ; output
+5 ; FBL - will be incremented by 1
+6 ; stores FBX in ^TMP("HLS",$J,FBL+1)
+7 ; if length of FBX exceeds 244 then continuation lines will be used
+8 ; example ^TMP($J,"HLS",$J,FBL+1,1)
+9 NEW FBLS
+10 SET FBL=FBL+1
+11 IF $LENGTH(FBX)<245
SET ^TMP("HLS",$JOB,FBL)=FBX
QUIT
+12 SET ^TMP("HLS",$JOB,FBL)=$EXTRACT(FBX,1,244)
+13 FOR FBLS=1:1
if $EXTRACT(FBX,(FBLS*244)+1,(FBLS*244)+244)=""
QUIT
Begin DoDot:1
+14 SET ^TMP("HLS",$JOB,FBL,FBLS)=$EXTRACT(FBX,(FBLS*244)+1,(FBLS*244)+244)
End DoDot:1
+15 QUIT
+16 ;
+17 ;FBFHLS
