FBPAID3B ;DSS/SCR - Utilities to support FEE BASIS PAID TO IB Process ;3/28/1012
;;3.5;FEE BASIS;**135**;JAN 30, 1995;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
EPFBPRV() ;EP FROM OPTION [FB PROVIDER TO IB]
;
;REPORTING OPTION FOR FB PAID TO IB AUTOMATIC INTERFACE TO IB NON/OTHER VA BILLING PROVIDER FILE
;
N DUOUT,DIRUT,DTOUT,FBQUIT,DIR,FBFROM,FBTO,FBDATE,FBIEN,FBNODE,FBPROG,FBNPI,FBNPISRT,Y,X1,X2,X,FBQUIT1
N FBTODATE
;
S FBQUIT1=0
F Q:FBQUIT1 D
.K ^TMP($J,"FBPAID3B")
.S FBQUIT=0
.D CLEAR()
.S DIR("A")="ENTER FIRST date to include in reports"
.S DIR(0)="D"
.D ^DIR
.I $D(DUOUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS ONE UP ARROW
.I $D(DIRUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
.I $D(DTOUT) S FBQUIT1=1 ;DEFINED IF USER TIMES OUT
.W:'FBQUIT1 " "_Y(0)
.I 'FBQUIT1 D
..S FBFROM=+Y
..S DIR("A")="ENTER LAST date to include in reports"
..S DIR(0)="D"
..D ^DIR
..I $D(DUOUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS ONE UP ARROW
..I $D(DIRUT) S FBQUIT1=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
..I $D(DTOUT) S FBQUIT1=1 ;DEFINED IF USER TIMES OUT
..W:'FBQUIT1 " "_Y(0)
.I 'FBQUIT1 D
..S FBTO=+Y
..S X1=FBFROM
..S X2=-1
..D C^%DTC ;SUBTRACT ONE DAY FROM THE 'START' DATE FOR $O
..S FBDATE=X
..;FIRST GATHER THE SORTED DATA TO BE REPORTED IN A TMP ARRAY
..F S FBDATE=$O(^FB(161.9,"AC",FBDATE)) Q:(FBDATE>FBTO)!(FBDATE="") D
...S FBIEN=0
...F S FBIEN=$O(^FB(161.9,"AC",FBDATE,FBIEN)) Q:FBIEN="" D
....S FBNODE=^FB(161.9,FBIEN,0)
....S FBPROG=$P(FBNODE,U,2)
....S FBNPI=$P(FBNODE,U,8)
....S:FBNPI'="" ^TMP($J,"FBPAID3B",FBDATE,FBPROG,FBNPI,FBIEN)=FBNODE ;only include processed records
..I '$D(^TMP($J,"FBPAID3B")) W !,"No Processed Entries in Date Range" Q
..;NOW SET UP FILTERING IN A LOOP so more than one report can be generated from it
..F Q:FBQUIT D
...D CLEAR()
...S DIR("A")="SELECT PROGRAM TYPE to include"
...S DIR(0)="S^3:OUTPATIENT;9:CIVIL HOSPITAL;0:BOTH"
...D ^DIR
...I $D(DUOUT) S FBQUIT=1 ;DEFINED IF USER ENTERS ONE UP ARROW
...I $D(DIRUT) S FBQUIT=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
...I $D(DTOUT) S FBQUIT=1 ;DEFINED IF USER TIMES OUT
...Q:FBQUIT
...S FBPROG=+Y
...S DIR("A")="SELECT NPI STATUS to include"
...S DIR(0)="S^0:FOR NO NPI UPDATES ATTEMPTED;1:NPI DATA INVALID;2:NPI MATCHED ACTIVE, NO UPDATES;"
...S DIR(0)=DIR(0)_"3:NPI MATCHED INACTIVE, NO UPDATES;4:NPI MATCHED ACTIVE, IB UPDATED;5:NPI NEW, IB RECORD CREATED;"
...S DIR(0)=DIR(0)_"99:ALL"
...D ^DIR
...I $D(DUOUT) S FBQUIT=1 ;DEFINED IF USER ENTERS ONE UP ARROW
...I $D(DIRUT) S FBQUIT=1 ;DEFINED IF USER ENTERS TWO UP ARROWS
...I $D(DTOUT) S FBQUIT=1 ;DEFINED IF USER TIMES OUT
...Q:FBQUIT
...S FBNPISRT=+Y
...D DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO)
K ^TMP($J,"FBPAID3B")
Q
DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO) ;DISPLAYS SUBSET OF SORTED INFO IN ^TMP
;
; INPUT : FBPROG - a number identifying the selected program
; FBNPISRT - a number indentifying the selected NPI sort value
; FBFROM - the "FROM DATE" selected by user
; FBTO - The "TO DATE" selected by user
;
N FBNDATE,FBTYPE1,FBNPI1,FBIEN,FBPATIEN,FBICTRL,FBLINUM,FBPTYPE,FBIBPNTR,FBQUIT,FBERR,FBHDSTG,FBHDSTG1
N FBICNTRL,FBPAT,FBTXY,FBVNDR,FBINVDT,FBHDSTG2,FBDAT1,FBDAT2,DO,DD,X,%,%H,%I,FBNOW,FBFIRST,%ZIS,FBPINFO
;
D NOW^%DTC
S Y=%
D DD^%DT
S FBNOW=Y
S FBQUIT=0
S FBFIRST=1
S %ZIS("A")="OUTPUT DEVICE: "
D ^%ZIS
I POP S FBQUIT=1
Q:FBQUIT
S FBNDATE=0
S Y=FBFROM
D DD^%DT
S FBDAT1=Y
S Y=FBTO
D DD^%DT
S FBDAT2=Y
W !
W ?10,"**** FEE BASIS PROVIDER TO IB REPORT ****"
W !,?20,FBNOW
W !,?8,"PROCESS DATES: "_FBDAT1_" - "_FBDAT2
W !,?8,"PROGRAM: "_$S(FBPROG=0:"BOTH",FBPROG=3:"OUTPATIENT",FBPROG=9:"CIVIL HOSPITAL",1:"")_" NPI SORT: "_$S(FBNPISRT=99:"ALL",1:$$GTNPIVAL(FBNPISRT))
W !
F S FBNDATE=$O(^TMP($J,"FBPAID3B",FBNDATE)) Q:(FBNDATE=""!FBQUIT) D
.S Y=FBNDATE
.D DD^%DT
.S FBHDSTG="PROCESS DATE: "_Y
.S FBTYPE1=""
.F S FBTYPE1=$O(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1)) Q:(FBTYPE1=""!FBQUIT) D
..I FBPROG'=0&(FBTYPE1'=FBPROG) Q ;NOT A PROGRAM TYPE WE WANT TO REPORT ON
..S:FBTYPE1=3 FBHDSTG1="OUTPATIENT"
..S:FBTYPE1=9 FBHDSTG1="CIVIL HOSPITAL"
..S FBNPI1=""
..S FBFIRST=1
..F S FBNPI1=$O(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1)) Q:(FBNPI1=""!FBQUIT) D
...I (FBNPISRT'=99)&(FBNPISRT'=FBNPI1) Q ;NOT AN NPI UPDATE VALUE WE WANT TO REPORT ON
...S FBHDSTG2=$$GTNPIVAL(FBNPI1)
...I ((IOT="VTRM")&'FBFIRST) D
....S DIR("A")="PRESS ENTER TO CONTINUE"
....S DIR(0)="FO"
....D ^DIR
....I $D(DUOUT) S FBQUIT=1 ;DEFINED IF USER ENTERS ONE UP ARROW
....I $D(DTOUT) S FBQUIT=1 ;DEFINED IF USER TIMES OUT
...Q:FBQUIT
...S FBIEN=0
...W !,?3,FBHDSTG_" "_FBHDSTG1_" "_FBHDSTG2,!
...F S FBIEN=$O(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN)) Q:FBIEN="" D
....S FBPATIEN=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,1)
....S FBICNTRL=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,3)
....S FBLINUM=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,5)
....S FBPTYPE=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,6)
....S FBIBPNTR=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,7)
....S FBTXY=$P(^TMP($J,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,9)
....;NOW GET INFO FROM THE FEE BASIS PAYMENT FILE IF THIS IS A TYPE 3
....I FBTYPE1=3 S FBPINFO=$$GTPYMNT(FBICNTRL)
....W:FBTYPE1=3 !,?5,$P(FBPINFO,U,1)_" => "_$P(FBPINFO,U,2)_" => "
....W:FBTYPE1=3 !,?8,$P(FBPINFO,U,3)_" => "_$P(FBPINFO,U,4)
....W:FBTYPE1=9 !,?5,"INVOICE: "_FBICNTRL
....W !,?5,"IB PROVIDER NAME: "_$$GTIBNAM(FBIBPNTR)
....W !,?8,$$GTTXYVAL(FBIEN)
....W !,?5,"PROVIDER TYPE: "_$$GTPRVTYP(FBIEN)
....W:FBLINUM>0 " "_"(LI) "_FBLINUM
....W !
....S FBFIRST=0
Q
;
GTPRVTYP(FBIEN) ;RETURNS EXTERNAL VALUE FOR A CODE IN A SET
;
Q:FBIEN="" ""
Q $$GET1^DIQ(161.9,FBIEN_",",.06,"","","FBERR")
;
GTIBNAM(FBIBPNTR) ;RETURNS EXTERNAL VALUE FOR NAME OF IB NON/OTHER VA BILLING PROVIDER
; INPUT : FBIBPNTR - pointer to the IB NON/OTHER VA BILLING PROVIDER FILE - 355,93
N FBERR
Q:FBIBPNTR="" ""
Q $$GET1^DIQ(355.93,FBIBPNTR_",",.01,"","","FBERR")
;
GTTXYVAL(FBIEN) ;RETURNS EXTERNAL VALUE FOR TAXONOMY UPDATE CODE
; INPUT : FBIEN - pointer to the FEE BASIS PAID TO IB file - 161.9
N FBERR
Q:FBIEN=""
Q $$GET1^DIQ(161.9,FBIEN_",",.09,"","","FBERR")
;
GTNPIVAL(FBNPI1) ;RETURNS EXTERNAL VALUE FOR A SET OF SORT CODES
; INPUT : FBNPI1 - USER SELECTED value from set of code
N FBERR
Q:FBNPI1="" ""
Q:FBNPI1=0 "NO NPI UPDATES ATTEMPTED"
Q:FBNPI1=1 "NPI DATA INVALID"
Q:FBNPI1=2 "NPI MATCHED ACTIVE, NO UPDATES"
Q:FBNPI1=3 "NPI MATCHED INACTIVE, NO UPDATES"
Q:FBNPI1=4 "NPI MATCHED ACTIVE, IB UPDATED"
Q:FBNPI1=5 "NPI NEW, IB RECORD CREATED"
Q -1
;
GTPYMNT(FBICNTRL) ;Get info from FEE BASIS PAYMENT
;INPUT : FBICNTRL - a four piece ';' delimitated string representing a sub record
N FBIENS,FBPAT,FBVNDR,FBINVDT,FBPROC
;
S FBIENS=$P(FBICNTRL,";",1)_","
S FBPAT=$$GET1^DIQ(162,FBIENS,.01,"","","FBERR")
S FBIENS=$P(FBICNTRL,";",2)_","_FBIENS
S FBVNDR=$$GET1^DIQ(162.01,FBIENS,.01,"","","FBERR")
S FBIENS=$P(FBICNTRL,";",3)_","_FBIENS
S FBINVDT=$$GET1^DIQ(162.02,FBIENS,.01,"","","FBERR")
S FBIENS=$P(FBICNTRL,";",4)_","_FBIENS
S FBPROC=$$GET1^DIQ(162.03,FBIENS,.01,"","","FBERR")
Q FBPAT_"^"_FBVNDR_"^"_FBINVDT_"^"_FBPROC
;
CLEAR() ;CLEARS A SPACE ON SCREEN AFTER REPORT
N FBLINE
F FBLINE=1:1:10 W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPAID3B 7636 printed Sep 23, 2025@19:35:31 Page 2
FBPAID3B ;DSS/SCR - Utilities to support FEE BASIS PAID TO IB Process ;3/28/1012
+1 ;;3.5;FEE BASIS;**135**;JAN 30, 1995;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EPFBPRV() ;EP FROM OPTION [FB PROVIDER TO IB]
+1 ;
+2 ;REPORTING OPTION FOR FB PAID TO IB AUTOMATIC INTERFACE TO IB NON/OTHER VA BILLING PROVIDER FILE
+3 ;
+4 NEW DUOUT,DIRUT,DTOUT,FBQUIT,DIR,FBFROM,FBTO,FBDATE,FBIEN,FBNODE,FBPROG,FBNPI,FBNPISRT,Y,X1,X2,X,FBQUIT1
+5 NEW FBTODATE
+6 ;
+7 SET FBQUIT1=0
+8 FOR
if FBQUIT1
QUIT
Begin DoDot:1
+9 KILL ^TMP($JOB,"FBPAID3B")
+10 SET FBQUIT=0
+11 DO CLEAR()
+12 SET DIR("A")="ENTER FIRST date to include in reports"
+13 SET DIR(0)="D"
+14 DO ^DIR
+15 ;DEFINED IF USER ENTERS ONE UP ARROW
IF $DATA(DUOUT)
SET FBQUIT1=1
+16 ;DEFINED IF USER ENTERS TWO UP ARROWS
IF $DATA(DIRUT)
SET FBQUIT1=1
+17 ;DEFINED IF USER TIMES OUT
IF $DATA(DTOUT)
SET FBQUIT1=1
+18 if 'FBQUIT1
WRITE " "_Y(0)
+19 IF 'FBQUIT1
Begin DoDot:2
+20 SET FBFROM=+Y
+21 SET DIR("A")="ENTER LAST date to include in reports"
+22 SET DIR(0)="D"
+23 DO ^DIR
+24 ;DEFINED IF USER ENTERS ONE UP ARROW
IF $DATA(DUOUT)
SET FBQUIT1=1
+25 ;DEFINED IF USER ENTERS TWO UP ARROWS
IF $DATA(DIRUT)
SET FBQUIT1=1
+26 ;DEFINED IF USER TIMES OUT
IF $DATA(DTOUT)
SET FBQUIT1=1
+27 if 'FBQUIT1
WRITE " "_Y(0)
End DoDot:2
+28 IF 'FBQUIT1
Begin DoDot:2
+29 SET FBTO=+Y
+30 SET X1=FBFROM
+31 SET X2=-1
+32 ;SUBTRACT ONE DAY FROM THE 'START' DATE FOR $O
DO C^%DTC
+33 SET FBDATE=X
+34 ;FIRST GATHER THE SORTED DATA TO BE REPORTED IN A TMP ARRAY
+35 FOR
SET FBDATE=$ORDER(^FB(161.9,"AC",FBDATE))
if (FBDATE>FBTO)!(FBDATE="")
QUIT
Begin DoDot:3
+36 SET FBIEN=0
+37 FOR
SET FBIEN=$ORDER(^FB(161.9,"AC",FBDATE,FBIEN))
if FBIEN=""
QUIT
Begin DoDot:4
+38 SET FBNODE=^FB(161.9,FBIEN,0)
+39 SET FBPROG=$PIECE(FBNODE,U,2)
+40 SET FBNPI=$PIECE(FBNODE,U,8)
+41 ;only include processed records
if FBNPI'=""
SET ^TMP($JOB,"FBPAID3B",FBDATE,FBPROG,FBNPI,FBIEN)=FBNODE
End DoDot:4
End DoDot:3
+42 IF '$DATA(^TMP($JOB,"FBPAID3B"))
WRITE !,"No Processed Entries in Date Range"
QUIT
+43 ;NOW SET UP FILTERING IN A LOOP so more than one report can be generated from it
+44 FOR
if FBQUIT
QUIT
Begin DoDot:3
+45 DO CLEAR()
+46 SET DIR("A")="SELECT PROGRAM TYPE to include"
+47 SET DIR(0)="S^3:OUTPATIENT;9:CIVIL HOSPITAL;0:BOTH"
+48 DO ^DIR
+49 ;DEFINED IF USER ENTERS ONE UP ARROW
IF $DATA(DUOUT)
SET FBQUIT=1
+50 ;DEFINED IF USER ENTERS TWO UP ARROWS
IF $DATA(DIRUT)
SET FBQUIT=1
+51 ;DEFINED IF USER TIMES OUT
IF $DATA(DTOUT)
SET FBQUIT=1
+52 if FBQUIT
QUIT
+53 SET FBPROG=+Y
+54 SET DIR("A")="SELECT NPI STATUS to include"
+55 SET DIR(0)="S^0:FOR NO NPI UPDATES ATTEMPTED;1:NPI DATA INVALID;2:NPI MATCHED ACTIVE, NO UPDATES;"
+56 SET DIR(0)=DIR(0)_"3:NPI MATCHED INACTIVE, NO UPDATES;4:NPI MATCHED ACTIVE, IB UPDATED;5:NPI NEW, IB RECORD CREATED;"
+57 SET DIR(0)=DIR(0)_"99:ALL"
+58 DO ^DIR
+59 ;DEFINED IF USER ENTERS ONE UP ARROW
IF $DATA(DUOUT)
SET FBQUIT=1
+60 ;DEFINED IF USER ENTERS TWO UP ARROWS
IF $DATA(DIRUT)
SET FBQUIT=1
+61 ;DEFINED IF USER TIMES OUT
IF $DATA(DTOUT)
SET FBQUIT=1
+62 if FBQUIT
QUIT
+63 SET FBNPISRT=+Y
+64 DO DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO)
End DoDot:3
End DoDot:2
End DoDot:1
+65 KILL ^TMP($JOB,"FBPAID3B")
+66 QUIT
DISPLAY(FBPROG,FBNPISRT,FBFROM,FBTO) ;DISPLAYS SUBSET OF SORTED INFO IN ^TMP
+1 ;
+2 ; INPUT : FBPROG - a number identifying the selected program
+3 ; FBNPISRT - a number indentifying the selected NPI sort value
+4 ; FBFROM - the "FROM DATE" selected by user
+5 ; FBTO - The "TO DATE" selected by user
+6 ;
+7 NEW FBNDATE,FBTYPE1,FBNPI1,FBIEN,FBPATIEN,FBICTRL,FBLINUM,FBPTYPE,FBIBPNTR,FBQUIT,FBERR,FBHDSTG,FBHDSTG1
+8 NEW FBICNTRL,FBPAT,FBTXY,FBVNDR,FBINVDT,FBHDSTG2,FBDAT1,FBDAT2,DO,DD,X,%,%H,%I,FBNOW,FBFIRST,%ZIS,FBPINFO
+9 ;
+10 DO NOW^%DTC
+11 SET Y=%
+12 DO DD^%DT
+13 SET FBNOW=Y
+14 SET FBQUIT=0
+15 SET FBFIRST=1
+16 SET %ZIS("A")="OUTPUT DEVICE: "
+17 DO ^%ZIS
+18 IF POP
SET FBQUIT=1
+19 if FBQUIT
QUIT
+20 SET FBNDATE=0
+21 SET Y=FBFROM
+22 DO DD^%DT
+23 SET FBDAT1=Y
+24 SET Y=FBTO
+25 DO DD^%DT
+26 SET FBDAT2=Y
+27 WRITE !
+28 WRITE ?10,"**** FEE BASIS PROVIDER TO IB REPORT ****"
+29 WRITE !,?20,FBNOW
+30 WRITE !,?8,"PROCESS DATES: "_FBDAT1_" - "_FBDAT2
+31 WRITE !,?8,"PROGRAM: "_$SELECT(FBPROG=0:"BOTH",FBPROG=3:"OUTPATIENT",FBPROG=9:"CIVIL HOSPITAL",1:"")_" NPI SORT: "_$SELECT(FBNPISRT=99:"ALL",1:$$GTNPIVAL(FBNPISRT))
+32 WRITE !
+33 FOR
SET FBNDATE=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE))
if (FBNDATE=""!FBQUIT)
QUIT
Begin DoDot:1
+34 SET Y=FBNDATE
+35 DO DD^%DT
+36 SET FBHDSTG="PROCESS DATE: "_Y
+37 SET FBTYPE1=""
+38 FOR
SET FBTYPE1=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1))
if (FBTYPE1=""!FBQUIT)
QUIT
Begin DoDot:2
+39 ;NOT A PROGRAM TYPE WE WANT TO REPORT ON
IF FBPROG'=0&(FBTYPE1'=FBPROG)
QUIT
+40 if FBTYPE1=3
SET FBHDSTG1="OUTPATIENT"
+41 if FBTYPE1=9
SET FBHDSTG1="CIVIL HOSPITAL"
+42 SET FBNPI1=""
+43 SET FBFIRST=1
+44 FOR
SET FBNPI1=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1))
if (FBNPI1=""!FBQUIT)
QUIT
Begin DoDot:3
+45 ;NOT AN NPI UPDATE VALUE WE WANT TO REPORT ON
IF (FBNPISRT'=99)&(FBNPISRT'=FBNPI1)
QUIT
+46 SET FBHDSTG2=$$GTNPIVAL(FBNPI1)
+47 IF ((IOT="VTRM")&'FBFIRST)
Begin DoDot:4
+48 SET DIR("A")="PRESS ENTER TO CONTINUE"
+49 SET DIR(0)="FO"
+50 DO ^DIR
+51 ;DEFINED IF USER ENTERS ONE UP ARROW
IF $DATA(DUOUT)
SET FBQUIT=1
+52 ;DEFINED IF USER TIMES OUT
IF $DATA(DTOUT)
SET FBQUIT=1
End DoDot:4
+53 if FBQUIT
QUIT
+54 SET FBIEN=0
+55 WRITE !,?3,FBHDSTG_" "_FBHDSTG1_" "_FBHDSTG2,!
+56 FOR
SET FBIEN=$ORDER(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN))
if FBIEN=""
QUIT
Begin DoDot:4
+57 SET FBPATIEN=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,1)
+58 SET FBICNTRL=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,3)
+59 SET FBLINUM=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,5)
+60 SET FBPTYPE=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,6)
+61 SET FBIBPNTR=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,7)
+62 SET FBTXY=$PIECE(^TMP($JOB,"FBPAID3B",FBNDATE,FBTYPE1,FBNPI1,FBIEN),U,9)
+63 ;NOW GET INFO FROM THE FEE BASIS PAYMENT FILE IF THIS IS A TYPE 3
+64 IF FBTYPE1=3
SET FBPINFO=$$GTPYMNT(FBICNTRL)
+65 if FBTYPE1=3
WRITE !,?5,$PIECE(FBPINFO,U,1)_" => "_$PIECE(FBPINFO,U,2)_" => "
+66 if FBTYPE1=3
WRITE !,?8,$PIECE(FBPINFO,U,3)_" => "_$PIECE(FBPINFO,U,4)
+67 if FBTYPE1=9
WRITE !,?5,"INVOICE: "_FBICNTRL
+68 WRITE !,?5,"IB PROVIDER NAME: "_$$GTIBNAM(FBIBPNTR)
+69 WRITE !,?8,$$GTTXYVAL(FBIEN)
+70 WRITE !,?5,"PROVIDER TYPE: "_$$GTPRVTYP(FBIEN)
+71 if FBLINUM>0
WRITE " "_"(LI) "_FBLINUM
+72 WRITE !
+73 SET FBFIRST=0
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+74 QUIT
+75 ;
GTPRVTYP(FBIEN) ;RETURNS EXTERNAL VALUE FOR A CODE IN A SET
+1 ;
+2 if FBIEN=""
QUIT ""
+3 QUIT $$GET1^DIQ(161.9,FBIEN_",",.06,"","","FBERR")
+4 ;
GTIBNAM(FBIBPNTR) ;RETURNS EXTERNAL VALUE FOR NAME OF IB NON/OTHER VA BILLING PROVIDER
+1 ; INPUT : FBIBPNTR - pointer to the IB NON/OTHER VA BILLING PROVIDER FILE - 355,93
+2 NEW FBERR
+3 if FBIBPNTR=""
QUIT ""
+4 QUIT $$GET1^DIQ(355.93,FBIBPNTR_",",.01,"","","FBERR")
+5 ;
GTTXYVAL(FBIEN) ;RETURNS EXTERNAL VALUE FOR TAXONOMY UPDATE CODE
+1 ; INPUT : FBIEN - pointer to the FEE BASIS PAID TO IB file - 161.9
+2 NEW FBERR
+3 if FBIEN=""
QUIT
+4 QUIT $$GET1^DIQ(161.9,FBIEN_",",.09,"","","FBERR")
+5 ;
GTNPIVAL(FBNPI1) ;RETURNS EXTERNAL VALUE FOR A SET OF SORT CODES
+1 ; INPUT : FBNPI1 - USER SELECTED value from set of code
+2 NEW FBERR
+3 if FBNPI1=""
QUIT ""
+4 if FBNPI1=0
QUIT "NO NPI UPDATES ATTEMPTED"
+5 if FBNPI1=1
QUIT "NPI DATA INVALID"
+6 if FBNPI1=2
QUIT "NPI MATCHED ACTIVE, NO UPDATES"
+7 if FBNPI1=3
QUIT "NPI MATCHED INACTIVE, NO UPDATES"
+8 if FBNPI1=4
QUIT "NPI MATCHED ACTIVE, IB UPDATED"
+9 if FBNPI1=5
QUIT "NPI NEW, IB RECORD CREATED"
+10 QUIT -1
+11 ;
GTPYMNT(FBICNTRL) ;Get info from FEE BASIS PAYMENT
+1 ;INPUT : FBICNTRL - a four piece ';' delimitated string representing a sub record
+2 NEW FBIENS,FBPAT,FBVNDR,FBINVDT,FBPROC
+3 ;
+4 SET FBIENS=$PIECE(FBICNTRL,";",1)_","
+5 SET FBPAT=$$GET1^DIQ(162,FBIENS,.01,"","","FBERR")
+6 SET FBIENS=$PIECE(FBICNTRL,";",2)_","_FBIENS
+7 SET FBVNDR=$$GET1^DIQ(162.01,FBIENS,.01,"","","FBERR")
+8 SET FBIENS=$PIECE(FBICNTRL,";",3)_","_FBIENS
+9 SET FBINVDT=$$GET1^DIQ(162.02,FBIENS,.01,"","","FBERR")
+10 SET FBIENS=$PIECE(FBICNTRL,";",4)_","_FBIENS
+11 SET FBPROC=$$GET1^DIQ(162.03,FBIENS,.01,"","","FBERR")
+12 QUIT FBPAT_"^"_FBVNDR_"^"_FBINVDT_"^"_FBPROC
+13 ;
CLEAR() ;CLEARS A SPACE ON SCREEN AFTER REPORT
+1 NEW FBLINE
+2 FOR FBLINE=1:1:10
WRITE !
+3 QUIT
+4
