- 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 Mar 13, 2025@21:01:44 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 ;
