FBAAV8 ;ALB/FA - BUILD IPAC MRA MESSAGE ;18 Dec 2013 10:04 AM
;;3.5;FEE BASIS;**123,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
;
;
;-----------------------------------------------------------------------------
; Entry Points
; EN - Transmit IPAC MRA Messages
; NOTE: (actually called from first line of routine)
;-----------------------------------------------------------------------------
;
EN ;EP
; Transmit IPAC MRA messages
; Input: FBFEE - Current # of FEE messages
; Output: IPAC MRA messages Transmitted
; FBFEE - Updated # of FEE messages
; FBNVP - 1 (if its not already set)
; FBSITE - Array Fee Basis Site Parameters (161.4)
; (if not already passed in)
; Called From: RTRAN@FBAAV0
N FBMSG,FBLN,FBSN,FBTXT,FBXMZ,MARIEN,X,ZMCNT
S ZMCNT=0,FBTXT=0,FBLN=0
S MRAIEN=""
F D Q:MRAIEN=""
. S MRAIEN=$O(^FBAA(161.96,"AS","P",MRAIEN))
. Q:MRAIEN=""
. Q:'$$EN1(MRAIEN,.FBMSG,.FBTXT,.FBLN,.FBSN,.FBXMZ,.ZMCNT) ; Build Message
;
Q:'$D(FBMSG) ; No more records to transmit
D XMIT^FBAAV01 ; Transmit data remaining records
D MRAUPDT(.FBMSG) ; Update MRA records with transmission date
Q
;
EN1(MRAIEN,FBMSG,FBTXT,FBLN,FBSN,FBXMZ,ZMCNT) ; Build the message lines for the specified
; MRA Record.
; Input: MRAIEN - IEN of the IPAC MRA record being sent
; FBMSG - Current Array of the MRA records that have currently been built
; for transmission, sorted by message number
; FBTXT - 0 - Header message not yet built
; 1 - Header message already built
; FBLN - Current Line count
; FBSN - 6 character (blank padded) station number or "" if not yet set
; FBXMZ - Current Message Number, "" if no header has been built yet
; ZMCNT - Current total line count
; Output: FBMSG - Updated Array of the MRA records that have currently been built
; for transmission, sorted by message number
; FBTXT - Updated to 1 if it was initially 0 to indicate that the
; IPAC MRA message header line was built
; FBLN - Updated Line count
; FBSN - 6 character (blank padded) station number
; FBXMZ - Updated Message Number (only updated if HEAD is called)
; ZMCNT - Updated total line count
; Returns: 1 - Message is built for the specified MRA record, 0 otherwise
; Called From: EN
N IX1,VAIEN
S VAIEN=$P(^FBAA(161.96,MRAIEN,0),U,2) ; IEN of the selected IPAC agreement
I VAIEN'="",'$D(^FBAA(161.95,VAIEN)) Q 0 ; Invalid IPAC Agreement IEN
S FBMSG(MRAIEN)="" ; Log the MRA record to be transmitted
D LNBLD(VAIEN,MRAIEN,.FBMSG,.FBXMZ,.FBLN,.FBSN,.FBTXT,.ZMCNT) ; Build message to be transmitted
Q 1
;
LNBLD(VAIEN,MRAIEN,FBMSG,FBXMZ,FBLN,FBSN,FBTXT,ZMCNT) ; Build the message
; Input: VAIEN - IEN of the IPAC Agreement of selected MRA record
; MRAIEN - IEN of the selected MRA record
; FBMSG - Array of the MRA records that have currently been built for
; transmission, sorted by message number
; FBXMZ - Current Message number
; FBLN - Current Line count
; FBSN - 6 character (blank padded) station number or "" if not yet set
; FBTXT - 0 - Header message not yet built
; 1 - Header message already built
; ZMCNT - Current total line count
; Output: FBXMZ - Updated Message number
; FBLN - Updated line count
; FBSN - 6 character (blank padded) station number
; FBTXT - Updated to 1 if it was initially 0 to indicate that the
; IPAC MRA message header line was built
; ZMCNT - Updated total line count
;
N ACT,FBSTR,IX1,VADATA,VAID,XX
S ACT=$P(^FBAA(161.96,MRAIEN,0),U,4) ; MRA Record Action
S VAID=$P(^FBAA(161.96,MRAIEN,0),U,3) ; Agreement ID
I ACT'="D" D ; Not a delete record
. F IX1=0:1:6 D
. . S VADATA(IX1)=$G(^FBAA(161.95,VAIEN,IX1)) ; Array of IPAC Vendor Agreement data
E D
. S VADATA(0)=VAID
;
I 'FBTXT D ; No header yet, build it now
. S FBTXT=1,ZMCNT=1,FBLN=0
. D HEAD(.FBLN,.FBXMZ,.FBSN)
;
S FBSTR=$$LINE1(MRAIEN,FBSN,.VADATA) ; 1st line of data for the MRA record
D STORE^FBAAV01
S ZMCNT=ZMCNT+1
I ACT'="D" D ; If we're not transmitting a delete record
. S FBSTR=$$LINE2(.VADATA) ; 2nd line of data for the MRA record
. D STORE^FBAAV01
. S FBSTR=$$LINE3(.VADATA) ; 3rd line of data for the MRA record
. D STORE^FBAAV01
. S FBSTR=$$LINE4(.VADATA) ; 4th line of data for the MRA record
. D STORE^FBAAV01
. S FBSTR=$$LINE5(.VADATA) ; 5th line of data for the MRA record
. D STORE^FBAAV01
. S FBSTR=$$LINE6(.VADATA) ; 6th line of data for the MRA record
. D STORE^FBAAV01
. S FBSTR=$$LINE7(.VADATA) ; 7th line of data for the MRA record
. D STORE^FBAAV01
. S ZMCNT=ZMCNT+6 ; Increment total line count
;
; Maximum total line count reached, transmit current lines
I ZMCNT>27 D
. D XMIT^FBAAV01 ; Transmit the current data
. D MRAUPDT(.FBMSG) ; Update MRA records with transmission date
. S ZMCNT=0,FBLN=0,FBTXT=0 ; Reset total line count, line count, header flag
Q
;
HEAD(FBLN,FBXMZ,FBSN) ; Create header line for IPAC MRA Message
; Input: FBLN - Current Line count of the message
; FBXMZ - Current Message number
; Output: FBLN - Updated Line count
; FBSN - Agency Station Number
; FBXMZ - Updated Message Number
;
N FB,FBAASN,FBBN,FBHD,FBJ,FBSTR
D NEWMSG^FBAAV01 ; FBOKTX,XMSUB,XMDUZ
S FBHD=$$HDR^FBAAUTL3() ; 'FEE' - first piece of batch header
D STATION^FBAAUTL ; Returns FBSN,FBAASN (and maybe FBSITE)
S FBSN=$$LJ^XLFSTR(FBSN,6) ; Station number padded with trailing spaces
D GETNXB^FBAAUTL ; Next Fee Basis Batch Number (FBBN)
;FB*3.5*158
S FBBN=$$RJ^XLFSTR(FBBN,7,"0") ; Padded with leading 0s to 7 digits as necessary
;
; Build header line for IPAC MRA Messages
S FBSTR=FBHD_"C8"_$TR($$FMTE^XLFDT(DT,"5DZ"),"/","")_FBSN_FBBN_"$"
D STORE^FBAAV01
Q
;
LINE1(MRAIEN,FBSN,VADATA) ; Create 1st message line for an MRA record
; Input: MRAIEN - IEN of the IPAC MRA record being transmitted
; FBSN - Agency Station # (6 chars padded with trailing spaces)
; VADATA - Array of IPAC Agreement data
; Returns: 1st line of data for the MRA record
; Called From: LNBLD
N FBSTR,VID,XX
;
; Build Line 1 of the Message for the selected MRA record
S FBSTR=8 ; 1st char, 1st line of IPAC Agreement data
S FBSTR=FBSTR_$P(^FBAA(161.96,MRAIEN,0),U,4) ; 2nd char - IPAC MRA Action type (A,C,D)
S FBSTR=FBSTR_FBSN ; 3-8 char - Agency Station Number
S XX=$P(VADATA(0),U,1) ; IPAC Agreement ID
S XX=$$LJ^XLFSTR(XX,10) ; IPAC Agreement ID padded with trailing spaces
S FBSTR=FBSTR_XX ; 9-18 char - IPAC Agreement ID
I '$D(VADATA(1)) Q FBSTR_"~$" ; Delete action being transmitted, quit now
S VID=$P(VADATA(0),U,2) ; IEN of the IPAC Agreement Vendor, "" for deleted
S XX=$P(^FBAAV(VID,0),U,2) ; Vendor ID number
S XX=$$LJ^XLFSTR(XX,11) ; Vendor ID # left justified, padded with trailing spaces
I $P(^FBAAV(VID,0),U,7)="3" D ; Pharmacy Vendor
. N CHAIN
. S CHAIN=$P(^FBAAV(VID,0),U,10) ; Pharmacy chain #
. S CHAIN=$$RJ^XLFSTR(CHAIN,4,"0") ; Chain padded with leading 0's
. S XX=$E(XX,1,9)_CHAIN ; Chain appended to the Vendor ID for pharmacy
E S XX=XX_" " ; Non-Pharmacy Vendor
S FBSTR=FBSTR_XX ; 19-31 char - Vendor ID
S FBSTR=FBSTR_$P(VADATA(0),U,3) ; 32-35 - IPAC Agreement Fiscal Year
S XX=$P(VADATA(0),U,5) ; IPAC Agreement Description
S XX=$$LJ^XLFSTR(XX,60) ; Description with trailing spaces
S FBSTR=FBSTR_XX ; 36-95 char - IPAC Agreement Description
S XX=$P(VADATA(0),U,6) ; IPAC Agreement Sharing #
S XX=$$LJ^XLFSTR(XX,13) ; Sharing Agreement padded with trailing spaces
S FBSTR=FBSTR_XX ; 96-108 char - Sharing Agreement #
S FBSTR=FBSTR_$P(VADATA(0),U,4)_"~" ; 109 char - IPAC Agreement Status ('A' or 'I')
Q FBSTR
;
LINE2(VADATA) ; Create 2nd message line for an MRA record
; Input: VADATA - Array of IPAC Agreement data
; Returns: 2nd line of data for the MRA record
; Called From: LNBLD
N FBSTR,XX
S XX=$P(VADATA(1),U,1) ; IPAC Agreement Customer ALC
S XX=$$LJ^XLFSTR(XX,8) ; Customer ALC with trailing spaces
S FBSTR=XX ; 1-8 Char - Customer ALC
S XX=$P(VADATA(1),U,2) ; IPAC Agreement Receiver TAS
S XX=$$LJ^XLFSTR(XX,27) ; Receiver TAS with trailing spaces
S FBSTR=FBSTR_XX ; 9-35 Char - Receiver TAS
S XX=$P(VADATA(1),U,5) ; IPAC Agreement Sender TAS
S XX=$$LJ^XLFSTR(XX,27) ; Sender TAS with trailing spaces
S FBSTR=FBSTR_XX ; 36-62 Char - Receiver TAS
S XX=$P(VADATA(1),U,3) ; IPAC Agreement Agency Field Station Number
S XX=$$LJ^XLFSTR(XX,8) ; Agency Field Station Number with trailing spaces
S FBSTR=FBSTR_XX ; 63-70 Char - Agency Field Station Number
S XX=$P(VADATA(1),U,4) ; IPAC Agreement Obligating Document #
S XX=$$LJ^XLFSTR(XX,17) ; Obligating Document # with trailing spaces
S FBSTR=FBSTR_XX_"~" ; 71-87 Char - Obligating Document #
Q FBSTR
LINE3(VADATA) ; Create 3rd message line for an MRA record
; Input: VADATA - Array of IPAC Agreement data
; Returns: 3rd line of data for the MRA record
; Called From: LNBLD
N FBSTR,XX
S XX=$P(VADATA(2),U,1) ; IPAC Agreement Station Contact Name
S XX=$$LJ^XLFSTR(XX,60) ; Station Contact Name with trailing spaces
S FBSTR=XX ; 1-60 char - Station Contact Name
S XX=$P(VADATA(2),U,2) ; IPAC Agreement Station Contact Phone
S XX=$$LJ^XLFSTR(XX,17) ; Station Contact Phone with trailing spaces
S FBSTR=FBSTR_XX ; 61-77 char - Station Contact Phone
S XX=$P(VADATA(2),U,3) ; IPAC Agreement Station Contact Email
S XX=$$LJ^XLFSTR(XX,100) ; Station Contact Email with trailing spaces
S FBSTR=FBSTR_XX_"~" ; 78-177 char - Station Contact Phone
Q FBSTR
;
LINE4(VADATA) ; Create 4th message line for an MRA record
; Input: VADATA - Array of IPAC Agreement data
; Returns: 4th line of data for the MRA record
; Called From: LNBLD
N FBSTR,XX
S XX=$P(VADATA(3),U,1) ; IPAC Agreement Station Complete line of Accounting
S XX=$$LJ^XLFSTR(XX,60) ; Complete line of accounting with trailing spaces
S FBSTR=XX_"~" ; 1-60 char - Complete line of Accounting
Q FBSTR
;
LINE5(VADATA) ; Create 5th message line for an MRA record
; Input: VADATA - Array of IPAC Agreement data
; Returns: 5th line of data for the MRA record
; Called From: LNBLD
N FBSTR,XX
S XX=$P(VADATA(4),U,1) ; IPAC Agreement Station Goods & Services
S XX=$$LJ^XLFSTR(XX,200) ; Goods & Services with trailing spaces
S FBSTR=XX_"~" ; 1-200 char - Goods & Services
Q FBSTR
;
LINE6(VADATA) ; Create 6th message line for an MRA record
; Input: VADATA - Array of IPAC Agreement data
; Returns: 6th line of data for the MRA record
; Called From: LNBLD
N FBSTR,XX
S XX=$P(VADATA(5),U,1) ; IPAC Agreement Miscellaneous Line 1
S XX=$$LJ^XLFSTR(XX,220) ; Miscellaneous Line 1 with trailing spaces
S FBSTR=XX_"~" ; 1-220 char - Miscellaneous Line 1
Q FBSTR
;
LINE7(VADATA) ; Create 7th message line for an MRA record
; Input: VADATA - Array of IPAC Agreement data
; Returns: 7tht line of data for the MRA record
; Called From: LNBLD
N FBSTR,XX
S XX=$P(VADATA(6),U,1) ; IPAC Agreement Miscellaneous Line 2
S XX=$$LJ^XLFSTR(XX,100) ; Miscellaneous Line 2 with trailing spaces
S FBSTR=XX_"~$" ; 1-100 char - Miscellaneous Line 2
Q FBSTR
Q
;
MRAUPDT(FBMSG) ; Update MRA records with transmit status and date
; Input: FBMSG() - Array of MRA IENs that were transmitted
; Output: MRA records updated with transmit status and date
; Called From: EN, LNBLD
N DA,DIE,DR,MRAIEN,X
S MRAIEN=""
F D Q:MRAIEN=""
. S MRAIEN=$O(FBMSG(MRAIEN))
. Q:MRAIEN=""
. S DIE="^FBAA(161.96,",DA=MRAIEN
. S DR="4///^S X="_"""TRANSMITTED"""
. S DR=DR_";5///TODAY"
. D ^DIE
. K FBMSG(MRAIEN)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAV8 14654 printed Sep 23, 2025@19:33:06 Page 2
FBAAV8 ;ALB/FA - BUILD IPAC MRA MESSAGE ;18 Dec 2013 10:04 AM
+1 ;;3.5;FEE BASIS;**123,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 ;-----------------------------------------------------------------------------
+6 ; Entry Points
+7 ; EN - Transmit IPAC MRA Messages
+8 ; NOTE: (actually called from first line of routine)
+9 ;-----------------------------------------------------------------------------
+10 ;
EN ;EP
+1 ; Transmit IPAC MRA messages
+2 ; Input: FBFEE - Current # of FEE messages
+3 ; Output: IPAC MRA messages Transmitted
+4 ; FBFEE - Updated # of FEE messages
+5 ; FBNVP - 1 (if its not already set)
+6 ; FBSITE - Array Fee Basis Site Parameters (161.4)
+7 ; (if not already passed in)
+8 ; Called From: RTRAN@FBAAV0
+9 NEW FBMSG,FBLN,FBSN,FBTXT,FBXMZ,MARIEN,X,ZMCNT
+10 SET ZMCNT=0
SET FBTXT=0
SET FBLN=0
+11 SET MRAIEN=""
+12 FOR
Begin DoDot:1
+13 SET MRAIEN=$ORDER(^FBAA(161.96,"AS","P",MRAIEN))
+14 if MRAIEN=""
QUIT
+15 ; Build Message
if '$$EN1(MRAIEN,.FBMSG,.FBTXT,.FBLN,.FBSN,.FBXMZ,.ZMCNT)
QUIT
End DoDot:1
if MRAIEN=""
QUIT
+16 ;
+17 ; No more records to transmit
if '$DATA(FBMSG)
QUIT
+18 ; Transmit data remaining records
DO XMIT^FBAAV01
+19 ; Update MRA records with transmission date
DO MRAUPDT(.FBMSG)
+20 QUIT
+21 ;
EN1(MRAIEN,FBMSG,FBTXT,FBLN,FBSN,FBXMZ,ZMCNT) ; Build the message lines for the specified
+1 ; MRA Record.
+2 ; Input: MRAIEN - IEN of the IPAC MRA record being sent
+3 ; FBMSG - Current Array of the MRA records that have currently been built
+4 ; for transmission, sorted by message number
+5 ; FBTXT - 0 - Header message not yet built
+6 ; 1 - Header message already built
+7 ; FBLN - Current Line count
+8 ; FBSN - 6 character (blank padded) station number or "" if not yet set
+9 ; FBXMZ - Current Message Number, "" if no header has been built yet
+10 ; ZMCNT - Current total line count
+11 ; Output: FBMSG - Updated Array of the MRA records that have currently been built
+12 ; for transmission, sorted by message number
+13 ; FBTXT - Updated to 1 if it was initially 0 to indicate that the
+14 ; IPAC MRA message header line was built
+15 ; FBLN - Updated Line count
+16 ; FBSN - 6 character (blank padded) station number
+17 ; FBXMZ - Updated Message Number (only updated if HEAD is called)
+18 ; ZMCNT - Updated total line count
+19 ; Returns: 1 - Message is built for the specified MRA record, 0 otherwise
+20 ; Called From: EN
+21 NEW IX1,VAIEN
+22 ; IEN of the selected IPAC agreement
SET VAIEN=$PIECE(^FBAA(161.96,MRAIEN,0),U,2)
+23 ; Invalid IPAC Agreement IEN
IF VAIEN'=""
IF '$DATA(^FBAA(161.95,VAIEN))
QUIT 0
+24 ; Log the MRA record to be transmitted
SET FBMSG(MRAIEN)=""
+25 ; Build message to be transmitted
DO LNBLD(VAIEN,MRAIEN,.FBMSG,.FBXMZ,.FBLN,.FBSN,.FBTXT,.ZMCNT)
+26 QUIT 1
+27 ;
LNBLD(VAIEN,MRAIEN,FBMSG,FBXMZ,FBLN,FBSN,FBTXT,ZMCNT) ; Build the message
+1 ; Input: VAIEN - IEN of the IPAC Agreement of selected MRA record
+2 ; MRAIEN - IEN of the selected MRA record
+3 ; FBMSG - Array of the MRA records that have currently been built for
+4 ; transmission, sorted by message number
+5 ; FBXMZ - Current Message number
+6 ; FBLN - Current Line count
+7 ; FBSN - 6 character (blank padded) station number or "" if not yet set
+8 ; FBTXT - 0 - Header message not yet built
+9 ; 1 - Header message already built
+10 ; ZMCNT - Current total line count
+11 ; Output: FBXMZ - Updated Message number
+12 ; FBLN - Updated line count
+13 ; FBSN - 6 character (blank padded) station number
+14 ; FBTXT - Updated to 1 if it was initially 0 to indicate that the
+15 ; IPAC MRA message header line was built
+16 ; ZMCNT - Updated total line count
+17 ;
+18 NEW ACT,FBSTR,IX1,VADATA,VAID,XX
+19 ; MRA Record Action
SET ACT=$PIECE(^FBAA(161.96,MRAIEN,0),U,4)
+20 ; Agreement ID
SET VAID=$PIECE(^FBAA(161.96,MRAIEN,0),U,3)
+21 ; Not a delete record
IF ACT'="D"
Begin DoDot:1
+22 FOR IX1=0:1:6
Begin DoDot:2
+23 ; Array of IPAC Vendor Agreement data
SET VADATA(IX1)=$GET(^FBAA(161.95,VAIEN,IX1))
End DoDot:2
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 SET VADATA(0)=VAID
End DoDot:1
+26 ;
+27 ; No header yet, build it now
IF 'FBTXT
Begin DoDot:1
+28 SET FBTXT=1
SET ZMCNT=1
SET FBLN=0
+29 DO HEAD(.FBLN,.FBXMZ,.FBSN)
End DoDot:1
+30 ;
+31 ; 1st line of data for the MRA record
SET FBSTR=$$LINE1(MRAIEN,FBSN,.VADATA)
+32 DO STORE^FBAAV01
+33 SET ZMCNT=ZMCNT+1
+34 ; If we're not transmitting a delete record
IF ACT'="D"
Begin DoDot:1
+35 ; 2nd line of data for the MRA record
SET FBSTR=$$LINE2(.VADATA)
+36 DO STORE^FBAAV01
+37 ; 3rd line of data for the MRA record
SET FBSTR=$$LINE3(.VADATA)
+38 DO STORE^FBAAV01
+39 ; 4th line of data for the MRA record
SET FBSTR=$$LINE4(.VADATA)
+40 DO STORE^FBAAV01
+41 ; 5th line of data for the MRA record
SET FBSTR=$$LINE5(.VADATA)
+42 DO STORE^FBAAV01
+43 ; 6th line of data for the MRA record
SET FBSTR=$$LINE6(.VADATA)
+44 DO STORE^FBAAV01
+45 ; 7th line of data for the MRA record
SET FBSTR=$$LINE7(.VADATA)
+46 DO STORE^FBAAV01
+47 ; Increment total line count
SET ZMCNT=ZMCNT+6
End DoDot:1
+48 ;
+49 ; Maximum total line count reached, transmit current lines
+50 IF ZMCNT>27
Begin DoDot:1
+51 ; Transmit the current data
DO XMIT^FBAAV01
+52 ; Update MRA records with transmission date
DO MRAUPDT(.FBMSG)
+53 ; Reset total line count, line count, header flag
SET ZMCNT=0
SET FBLN=0
SET FBTXT=0
End DoDot:1
+54 QUIT
+55 ;
HEAD(FBLN,FBXMZ,FBSN) ; Create header line for IPAC MRA Message
+1 ; Input: FBLN - Current Line count of the message
+2 ; FBXMZ - Current Message number
+3 ; Output: FBLN - Updated Line count
+4 ; FBSN - Agency Station Number
+5 ; FBXMZ - Updated Message Number
+6 ;
+7 NEW FB,FBAASN,FBBN,FBHD,FBJ,FBSTR
+8 ; FBOKTX,XMSUB,XMDUZ
DO NEWMSG^FBAAV01
+9 ; 'FEE' - first piece of batch header
SET FBHD=$$HDR^FBAAUTL3()
+10 ; Returns FBSN,FBAASN (and maybe FBSITE)
DO STATION^FBAAUTL
+11 ; Station number padded with trailing spaces
SET FBSN=$$LJ^XLFSTR(FBSN,6)
+12 ; Next Fee Basis Batch Number (FBBN)
DO GETNXB^FBAAUTL
+13 ;FB*3.5*158
+14 ; Padded with leading 0s to 7 digits as necessary
SET FBBN=$$RJ^XLFSTR(FBBN,7,"0")
+15 ;
+16 ; Build header line for IPAC MRA Messages
+17 SET FBSTR=FBHD_"C8"_$TRANSLATE($$FMTE^XLFDT(DT,"5DZ"),"/","")_FBSN_FBBN_"$"
+18 DO STORE^FBAAV01
+19 QUIT
+20 ;
LINE1(MRAIEN,FBSN,VADATA) ; Create 1st message line for an MRA record
+1 ; Input: MRAIEN - IEN of the IPAC MRA record being transmitted
+2 ; FBSN - Agency Station # (6 chars padded with trailing spaces)
+3 ; VADATA - Array of IPAC Agreement data
+4 ; Returns: 1st line of data for the MRA record
+5 ; Called From: LNBLD
+6 NEW FBSTR,VID,XX
+7 ;
+8 ; Build Line 1 of the Message for the selected MRA record
+9 ; 1st char, 1st line of IPAC Agreement data
SET FBSTR=8
+10 ; 2nd char - IPAC MRA Action type (A,C,D)
SET FBSTR=FBSTR_$PIECE(^FBAA(161.96,MRAIEN,0),U,4)
+11 ; 3-8 char - Agency Station Number
SET FBSTR=FBSTR_FBSN
+12 ; IPAC Agreement ID
SET XX=$PIECE(VADATA(0),U,1)
+13 ; IPAC Agreement ID padded with trailing spaces
SET XX=$$LJ^XLFSTR(XX,10)
+14 ; 9-18 char - IPAC Agreement ID
SET FBSTR=FBSTR_XX
+15 ; Delete action being transmitted, quit now
IF '$DATA(VADATA(1))
QUIT FBSTR_"~$"
+16 ; IEN of the IPAC Agreement Vendor, "" for deleted
SET VID=$PIECE(VADATA(0),U,2)
+17 ; Vendor ID number
SET XX=$PIECE(^FBAAV(VID,0),U,2)
+18 ; Vendor ID # left justified, padded with trailing spaces
SET XX=$$LJ^XLFSTR(XX,11)
+19 ; Pharmacy Vendor
IF $PIECE(^FBAAV(VID,0),U,7)="3"
Begin DoDot:1
+20 NEW CHAIN
+21 ; Pharmacy chain #
SET CHAIN=$PIECE(^FBAAV(VID,0),U,10)
+22 ; Chain padded with leading 0's
SET CHAIN=$$RJ^XLFSTR(CHAIN,4,"0")
+23 ; Chain appended to the Vendor ID for pharmacy
SET XX=$EXTRACT(XX,1,9)_CHAIN
End DoDot:1
+24 ; Non-Pharmacy Vendor
IF '$TEST
SET XX=XX_" "
+25 ; 19-31 char - Vendor ID
SET FBSTR=FBSTR_XX
+26 ; 32-35 - IPAC Agreement Fiscal Year
SET FBSTR=FBSTR_$PIECE(VADATA(0),U,3)
+27 ; IPAC Agreement Description
SET XX=$PIECE(VADATA(0),U,5)
+28 ; Description with trailing spaces
SET XX=$$LJ^XLFSTR(XX,60)
+29 ; 36-95 char - IPAC Agreement Description
SET FBSTR=FBSTR_XX
+30 ; IPAC Agreement Sharing #
SET XX=$PIECE(VADATA(0),U,6)
+31 ; Sharing Agreement padded with trailing spaces
SET XX=$$LJ^XLFSTR(XX,13)
+32 ; 96-108 char - Sharing Agreement #
SET FBSTR=FBSTR_XX
+33 ; 109 char - IPAC Agreement Status ('A' or 'I')
SET FBSTR=FBSTR_$PIECE(VADATA(0),U,4)_"~"
+34 QUIT FBSTR
+35 ;
LINE2(VADATA) ; Create 2nd message line for an MRA record
+1 ; Input: VADATA - Array of IPAC Agreement data
+2 ; Returns: 2nd line of data for the MRA record
+3 ; Called From: LNBLD
+4 NEW FBSTR,XX
+5 ; IPAC Agreement Customer ALC
SET XX=$PIECE(VADATA(1),U,1)
+6 ; Customer ALC with trailing spaces
SET XX=$$LJ^XLFSTR(XX,8)
+7 ; 1-8 Char - Customer ALC
SET FBSTR=XX
+8 ; IPAC Agreement Receiver TAS
SET XX=$PIECE(VADATA(1),U,2)
+9 ; Receiver TAS with trailing spaces
SET XX=$$LJ^XLFSTR(XX,27)
+10 ; 9-35 Char - Receiver TAS
SET FBSTR=FBSTR_XX
+11 ; IPAC Agreement Sender TAS
SET XX=$PIECE(VADATA(1),U,5)
+12 ; Sender TAS with trailing spaces
SET XX=$$LJ^XLFSTR(XX,27)
+13 ; 36-62 Char - Receiver TAS
SET FBSTR=FBSTR_XX
+14 ; IPAC Agreement Agency Field Station Number
SET XX=$PIECE(VADATA(1),U,3)
+15 ; Agency Field Station Number with trailing spaces
SET XX=$$LJ^XLFSTR(XX,8)
+16 ; 63-70 Char - Agency Field Station Number
SET FBSTR=FBSTR_XX
+17 ; IPAC Agreement Obligating Document #
SET XX=$PIECE(VADATA(1),U,4)
+18 ; Obligating Document # with trailing spaces
SET XX=$$LJ^XLFSTR(XX,17)
+19 ; 71-87 Char - Obligating Document #
SET FBSTR=FBSTR_XX_"~"
+20 QUIT FBSTR
LINE3(VADATA) ; Create 3rd message line for an MRA record
+1 ; Input: VADATA - Array of IPAC Agreement data
+2 ; Returns: 3rd line of data for the MRA record
+3 ; Called From: LNBLD
+4 NEW FBSTR,XX
+5 ; IPAC Agreement Station Contact Name
SET XX=$PIECE(VADATA(2),U,1)
+6 ; Station Contact Name with trailing spaces
SET XX=$$LJ^XLFSTR(XX,60)
+7 ; 1-60 char - Station Contact Name
SET FBSTR=XX
+8 ; IPAC Agreement Station Contact Phone
SET XX=$PIECE(VADATA(2),U,2)
+9 ; Station Contact Phone with trailing spaces
SET XX=$$LJ^XLFSTR(XX,17)
+10 ; 61-77 char - Station Contact Phone
SET FBSTR=FBSTR_XX
+11 ; IPAC Agreement Station Contact Email
SET XX=$PIECE(VADATA(2),U,3)
+12 ; Station Contact Email with trailing spaces
SET XX=$$LJ^XLFSTR(XX,100)
+13 ; 78-177 char - Station Contact Phone
SET FBSTR=FBSTR_XX_"~"
+14 QUIT FBSTR
+15 ;
LINE4(VADATA) ; Create 4th message line for an MRA record
+1 ; Input: VADATA - Array of IPAC Agreement data
+2 ; Returns: 4th line of data for the MRA record
+3 ; Called From: LNBLD
+4 NEW FBSTR,XX
+5 ; IPAC Agreement Station Complete line of Accounting
SET XX=$PIECE(VADATA(3),U,1)
+6 ; Complete line of accounting with trailing spaces
SET XX=$$LJ^XLFSTR(XX,60)
+7 ; 1-60 char - Complete line of Accounting
SET FBSTR=XX_"~"
+8 QUIT FBSTR
+9 ;
LINE5(VADATA) ; Create 5th message line for an MRA record
+1 ; Input: VADATA - Array of IPAC Agreement data
+2 ; Returns: 5th line of data for the MRA record
+3 ; Called From: LNBLD
+4 NEW FBSTR,XX
+5 ; IPAC Agreement Station Goods & Services
SET XX=$PIECE(VADATA(4),U,1)
+6 ; Goods & Services with trailing spaces
SET XX=$$LJ^XLFSTR(XX,200)
+7 ; 1-200 char - Goods & Services
SET FBSTR=XX_"~"
+8 QUIT FBSTR
+9 ;
LINE6(VADATA) ; Create 6th message line for an MRA record
+1 ; Input: VADATA - Array of IPAC Agreement data
+2 ; Returns: 6th line of data for the MRA record
+3 ; Called From: LNBLD
+4 NEW FBSTR,XX
+5 ; IPAC Agreement Miscellaneous Line 1
SET XX=$PIECE(VADATA(5),U,1)
+6 ; Miscellaneous Line 1 with trailing spaces
SET XX=$$LJ^XLFSTR(XX,220)
+7 ; 1-220 char - Miscellaneous Line 1
SET FBSTR=XX_"~"
+8 QUIT FBSTR
+9 ;
LINE7(VADATA) ; Create 7th message line for an MRA record
+1 ; Input: VADATA - Array of IPAC Agreement data
+2 ; Returns: 7tht line of data for the MRA record
+3 ; Called From: LNBLD
+4 NEW FBSTR,XX
+5 ; IPAC Agreement Miscellaneous Line 2
SET XX=$PIECE(VADATA(6),U,1)
+6 ; Miscellaneous Line 2 with trailing spaces
SET XX=$$LJ^XLFSTR(XX,100)
+7 ; 1-100 char - Miscellaneous Line 2
SET FBSTR=XX_"~$"
+8 QUIT FBSTR
+9 QUIT
+10 ;
MRAUPDT(FBMSG) ; Update MRA records with transmit status and date
+1 ; Input: FBMSG() - Array of MRA IENs that were transmitted
+2 ; Output: MRA records updated with transmit status and date
+3 ; Called From: EN, LNBLD
+4 NEW DA,DIE,DR,MRAIEN,X
+5 SET MRAIEN=""
+6 FOR
Begin DoDot:1
+7 SET MRAIEN=$ORDER(FBMSG(MRAIEN))
+8 if MRAIEN=""
QUIT
+9 SET DIE="^FBAA(161.96,"
SET DA=MRAIEN
+10 SET DR="4///^S X="_"""TRANSMITTED"""
+11 SET DR=DR_";5///TODAY"
+12 DO ^DIE
+13 KILL FBMSG(MRAIEN)
End DoDot:1
if MRAIEN=""
QUIT
+14 QUIT
+15 ;
