FBUTL8 ;DSS/BPD - FEE BASIS UTILITY FOR PROVIDER INFORMATION ;5/11/2011
;;3.5;FEE BASIS;**122,133**;JAN 30, 1995;Build 5
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
RPROV(FBPROV,FBPROVD) ; Prompt for line item rendering providers
;
; Input
; FBPROV - required, array passed by reference
; will be initialized (killed)
; array of any entered line item rendering providers
; format
; FBPROV(#)=NAME^NPI^TAXONOMY
; FBPROVD- optional, array passed by reference
; same format as FBPROV
; if passed, it will be used to supply default values
; normally only used when editing an existing payment
; Result (value of $$ADJ extrinsic function)
; FBRET - boulean value (0 or 1)
; = 1 when valid line item rendering providers entered
; = 0 when processed ended due to time-out or entry of '^'
; Output
; FBPROV - the FBPROV input array passed by reference will be modified
; if the result = 1 then it will contain entered line item rendering providers
; if the result = 0 then it will be undefined
;
N FBADJR,FBCAS,FBCNT,FBEDIT,FBERR,FBI,FBNEW,FBRET
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=1,FBEDIT=0
S FBNOOUT=$G(FBNOOUT,0)
K FBPROV
;
; if existing LI Rendering Provider exist then load them into array
I $D(FBPROVD) M FBPROV=FBPROVD
S (FBCNT,FBCAS)=0
I $D(FBPROV) S FBI=0 F S FBI=$O(FBPROV(FBI)) Q:'FBI D
. S FBCNT=FBCNT+1
;
ASKRPROV ; multiply prompt for rendering providers
;
; display current list of Rendering Providers
I FBCNT>0 D
. W !!,"Current list of Line Item Rendering Providers: "
. I '$O(FBPROV(0)) W "none"
. S FBI=0 F S FBI=$O(FBPROV(FBI)) Q:'FBI D
. . W !?3,"Line Item: "_FBI
. . W ?25,"Rendering Provider Name: "_$P(FBPROV(FBI),U)
. . W !?3,"Rendering Provider NPI: "_$P(FBPROV(FBI),U,2)
. . W ?45,"Taxonomy Code: "_$P(FBPROV(FBI),U,3)
;
; prompt for Line Item Rendering Provider
N FBI,FBPROVR
S DIR(0)="162.579,.01",DIR("A")="Enter LINE ITEM NUMBER"
S DIR("?",1)="Please enter the Rendering Provider information for a specific line item."
S DIR("?",2)="This information is only required if the line item transaction has a different Rendering Provider than the claim."
D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!(Y="") G EXIT
S FBI=+Y I Y'=0,$G(FBPROV(+Y))'="" S FBEDIT=1
I 'FBEDIT S FBPROV(FBI)=""
S DIR(0)="162.579,.02" I FBEDIT=1,$D(FBPROV(FBI)) S DIR("B")=$P(FBPROV(FBI),U)
S DIR("A")="LINE ITEM RENDERING PROV NAME",DIR("?",1)="Enter the Rendering Provider's Name for the specified line item,"
S DIR("?",2)="if different than the claim level Rendering Provider" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) G EXIT
I X="@" D DEL(FBI)
S $P(FBPROV(FBI),U)=Y
S DIR(0)="162.579,.03" I FBEDIT=1,$D(FBPROV(FBI)) S DIR("B")=$P(FBPROV(FBI),U,2)
S DIR("A")="LINE ITEM RENDERING PROV NPI",DIR("?",1)="Enter the Rendering Provider's NPI for the specified line item."
S DIR("?",2)="if different than the claim level Rendering Provider" D ^DIR K DIR I $D(DTOUT)!($D(DIOUT)) G EXIT
S $P(FBPROV(FBI),U,2)=Y
S DIR(0)="162.579,.04",DIR("A")="LINE ITEM RENDERING PROV TAXONOMY CODE" I FBEDIT=1,$D(FBPROV(FBI)) S DIR("B")=$P(FBPROV(FBI),U,3)
S DIR("?",1)="Enter the Rendering Provider's Name for the specified line item,"
S DIR("?",2)="if different than the claim level Rendering Provider" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) G EXIT
S $P(FBPROV(FBI),U,3)=Y
S DIR(0)="Y",DIR("B")="NO",DIR("A")="ENTER ANOTHER LINE ITEM RENDERING PROVIDER"
S DIR("?")="Do you need to enter another Line Item level Rendering Provider?",DIR("?",1)="Answering yes will prompt you for more information or allow"
S DIR("?",2)="you to modify an entered record." D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) G EXIT
I FBPROV(FBI)="" K FBPROV(FBI)
G:Y ASKRPROV G:'Y EXIT
;
EXIT Q FBRET
;
DEL(FBI) ; delete Rendering Provider from list
K FBPROV(FBI)
W " (provider deleted)"
Q
;
;FBUTL2
FILERP(FBIENS,FBPROV) ; Routine to file Rendering Provider information to 162.5
;
; Input
; IENS - Required - DA_"," for the record to save the Rendering Provider information to
; FBPROV - Required - Passed by reference array that contains the information to save
;
; Output
; Data in File 162.5 will be modified
;
N FB,FBFDA,FBI
;
; delete line item rendering providers currently on file
D GETS^DIQ(162.5,FBIENS,"79*","","FB")
K FBFDA
S FBSIENS="" F S FBSIENS=$O(FB(162.579,FBSIENS)) Q:FBSIENS="" D
.S FBFDA(162.579,FBSIENS,.01)="@"
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
; file line item rendering providers from input array
K FBFDA
S FBI=0 F S FBI=$O(FBPROV(FBI)) Q:'FBI D
.S FBFDA(162.579,"+"_FBI_","_FBIENS,.01)=FBI
.S FBFDA(162.579,"+"_FBI_","_FBIENS,.02)=$P(FBPROV(FBI),U)
.S FBFDA(162.579,"+"_FBI_","_FBIENS,.03)=$P(FBPROV(FBI),U,2)
.S FBFDA(162.579,"+"_FBI_","_FBIENS,.04)=$P(FBPROV(FBI),U,3)
I $D(FBFDA) D UPDATE^DIE("","FBFDA")
;
Q
LOADRP(FBIENS,FBPROV) ; Load Line Item Rendering Providers
; Input
; FBIENS - required, internal entry numbers for subfile 162.5
; in standard format as specified for FileMan DBS calls
; FBPROV - required, array passed by reference
; array to load line item rendering providers into
; Output
; FBPROV - the FBPROV input array passed by reference will be modified
; format
; FBPROV(#)=IEN^NAME^NPI^TAXONOMY
; if no line item rendering providers are on file then the array will be undefined
N FB,FBC,FBSIENS
;
K FBPROV
;
S FBC=0
D GETS^DIQ(162.5,FBIENS,"79*","I","FB")
S FBSIENS="" F S FBSIENS=$O(FB(162.579,FBSIENS)) Q:FBSIENS="" D
. S FBC=FB(162.579,FBSIENS,.01,"I")
. S FBPROV(FBC)=FB(162.579,FBSIENS,.02,"I")
. S $P(FBPROV(FBC),U,2)=FB(162.579,FBSIENS,.03,"I")
. S $P(FBPROV(FBC),U,3)=FB(162.579,FBSIENS,.04,"I")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUTL8 6012 printed Nov 22, 2024@17:11 Page 2
FBUTL8 ;DSS/BPD - FEE BASIS UTILITY FOR PROVIDER INFORMATION ;5/11/2011
+1 ;;3.5;FEE BASIS;**122,133**;JAN 30, 1995;Build 5
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
RPROV(FBPROV,FBPROVD) ; Prompt for line item rendering providers
+1 ;
+2 ; Input
+3 ; FBPROV - required, array passed by reference
+4 ; will be initialized (killed)
+5 ; array of any entered line item rendering providers
+6 ; format
+7 ; FBPROV(#)=NAME^NPI^TAXONOMY
+8 ; FBPROVD- optional, array passed by reference
+9 ; same format as FBPROV
+10 ; if passed, it will be used to supply default values
+11 ; normally only used when editing an existing payment
+12 ; Result (value of $$ADJ extrinsic function)
+13 ; FBRET - boulean value (0 or 1)
+14 ; = 1 when valid line item rendering providers entered
+15 ; = 0 when processed ended due to time-out or entry of '^'
+16 ; Output
+17 ; FBPROV - the FBPROV input array passed by reference will be modified
+18 ; if the result = 1 then it will contain entered line item rendering providers
+19 ; if the result = 0 then it will be undefined
+20 ;
+21 NEW FBADJR,FBCAS,FBCNT,FBEDIT,FBERR,FBI,FBNEW,FBRET
+22 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+23 SET FBRET=1
SET FBEDIT=0
+24 SET FBNOOUT=$GET(FBNOOUT,0)
+25 KILL FBPROV
+26 ;
+27 ; if existing LI Rendering Provider exist then load them into array
+28 IF $DATA(FBPROVD)
MERGE FBPROV=FBPROVD
+29 SET (FBCNT,FBCAS)=0
+30 IF $DATA(FBPROV)
SET FBI=0
FOR
SET FBI=$ORDER(FBPROV(FBI))
if 'FBI
QUIT
Begin DoDot:1
+31 SET FBCNT=FBCNT+1
End DoDot:1
+32 ;
ASKRPROV ; multiply prompt for rendering providers
+1 ;
+2 ; display current list of Rendering Providers
+3 IF FBCNT>0
Begin DoDot:1
+4 WRITE !!,"Current list of Line Item Rendering Providers: "
+5 IF '$ORDER(FBPROV(0))
WRITE "none"
+6 SET FBI=0
FOR
SET FBI=$ORDER(FBPROV(FBI))
if 'FBI
QUIT
Begin DoDot:2
+7 WRITE !?3,"Line Item: "_FBI
+8 WRITE ?25,"Rendering Provider Name: "_$PIECE(FBPROV(FBI),U)
+9 WRITE !?3,"Rendering Provider NPI: "_$PIECE(FBPROV(FBI),U,2)
+10 WRITE ?45,"Taxonomy Code: "_$PIECE(FBPROV(FBI),U,3)
End DoDot:2
End DoDot:1
+11 ;
+12 ; prompt for Line Item Rendering Provider
+13 NEW FBI,FBPROVR
+14 SET DIR(0)="162.579,.01"
SET DIR("A")="Enter LINE ITEM NUMBER"
+15 SET DIR("?",1)="Please enter the Rendering Provider information for a specific line item."
+16 SET DIR("?",2)="This information is only required if the line item transaction has a different Rendering Provider than the claim."
+17 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))!(Y="")
GOTO EXIT
+18 SET FBI=+Y
IF Y'=0
IF $GET(FBPROV(+Y))'=""
SET FBEDIT=1
+19 IF 'FBEDIT
SET FBPROV(FBI)=""
+20 SET DIR(0)="162.579,.02"
IF FBEDIT=1
IF $DATA(FBPROV(FBI))
SET DIR("B")=$PIECE(FBPROV(FBI),U)
+21 SET DIR("A")="LINE ITEM RENDERING PROV NAME"
SET DIR("?",1)="Enter the Rendering Provider's Name for the specified line item,"
+22 SET DIR("?",2)="if different than the claim level Rendering Provider"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+23 IF X="@"
DO DEL(FBI)
+24 SET $PIECE(FBPROV(FBI),U)=Y
+25 SET DIR(0)="162.579,.03"
IF FBEDIT=1
IF $DATA(FBPROV(FBI))
SET DIR("B")=$PIECE(FBPROV(FBI),U,2)
+26 SET DIR("A")="LINE ITEM RENDERING PROV NPI"
SET DIR("?",1)="Enter the Rendering Provider's NPI for the specified line item."
+27 SET DIR("?",2)="if different than the claim level Rendering Provider"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DIOUT))
GOTO EXIT
+28 SET $PIECE(FBPROV(FBI),U,2)=Y
+29 SET DIR(0)="162.579,.04"
SET DIR("A")="LINE ITEM RENDERING PROV TAXONOMY CODE"
IF FBEDIT=1
IF $DATA(FBPROV(FBI))
SET DIR("B")=$PIECE(FBPROV(FBI),U,3)
+30 SET DIR("?",1)="Enter the Rendering Provider's Name for the specified line item,"
+31 SET DIR("?",2)="if different than the claim level Rendering Provider"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+32 SET $PIECE(FBPROV(FBI),U,3)=Y
+33 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="ENTER ANOTHER LINE ITEM RENDERING PROVIDER"
+34 SET DIR("?")="Do you need to enter another Line Item level Rendering Provider?"
SET DIR("?",1)="Answering yes will prompt you for more information or allow"
+35 SET DIR("?",2)="you to modify an entered record."
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+36 IF FBPROV(FBI)=""
KILL FBPROV(FBI)
+37 if Y
GOTO ASKRPROV
if 'Y
GOTO EXIT
+38 ;
EXIT QUIT FBRET
+1 ;
DEL(FBI) ; delete Rendering Provider from list
+1 KILL FBPROV(FBI)
+2 WRITE " (provider deleted)"
+3 QUIT
+4 ;
+5 ;FBUTL2
FILERP(FBIENS,FBPROV) ; Routine to file Rendering Provider information to 162.5
+1 ;
+2 ; Input
+3 ; IENS - Required - DA_"," for the record to save the Rendering Provider information to
+4 ; FBPROV - Required - Passed by reference array that contains the information to save
+5 ;
+6 ; Output
+7 ; Data in File 162.5 will be modified
+8 ;
+9 NEW FB,FBFDA,FBI
+10 ;
+11 ; delete line item rendering providers currently on file
+12 DO GETS^DIQ(162.5,FBIENS,"79*","","FB")
+13 KILL FBFDA
+14 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.579,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+15 SET FBFDA(162.579,FBSIENS,.01)="@"
End DoDot:1
+16 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+17 ;
+18 ; file line item rendering providers from input array
+19 KILL FBFDA
+20 SET FBI=0
FOR
SET FBI=$ORDER(FBPROV(FBI))
if 'FBI
QUIT
Begin DoDot:1
+21 SET FBFDA(162.579,"+"_FBI_","_FBIENS,.01)=FBI
+22 SET FBFDA(162.579,"+"_FBI_","_FBIENS,.02)=$PIECE(FBPROV(FBI),U)
+23 SET FBFDA(162.579,"+"_FBI_","_FBIENS,.03)=$PIECE(FBPROV(FBI),U,2)
+24 SET FBFDA(162.579,"+"_FBI_","_FBIENS,.04)=$PIECE(FBPROV(FBI),U,3)
End DoDot:1
+25 IF $DATA(FBFDA)
DO UPDATE^DIE("","FBFDA")
+26 ;
+27 QUIT
LOADRP(FBIENS,FBPROV) ; Load Line Item Rendering Providers
+1 ; Input
+2 ; FBIENS - required, internal entry numbers for subfile 162.5
+3 ; in standard format as specified for FileMan DBS calls
+4 ; FBPROV - required, array passed by reference
+5 ; array to load line item rendering providers into
+6 ; Output
+7 ; FBPROV - the FBPROV input array passed by reference will be modified
+8 ; format
+9 ; FBPROV(#)=IEN^NAME^NPI^TAXONOMY
+10 ; if no line item rendering providers are on file then the array will be undefined
+11 NEW FB,FBC,FBSIENS
+12 ;
+13 KILL FBPROV
+14 ;
+15 SET FBC=0
+16 DO GETS^DIQ(162.5,FBIENS,"79*","I","FB")
+17 SET FBSIENS=""
FOR
SET FBSIENS=$ORDER(FB(162.579,FBSIENS))
if FBSIENS=""
QUIT
Begin DoDot:1
+18 SET FBC=FB(162.579,FBSIENS,.01,"I")
+19 SET FBPROV(FBC)=FB(162.579,FBSIENS,.02,"I")
+20 SET $PIECE(FBPROV(FBC),U,2)=FB(162.579,FBSIENS,.03,"I")
+21 SET $PIECE(FBPROV(FBC),U,3)=FB(162.579,FBSIENS,.04,"I")
End DoDot:1
+22 ;
+23 QUIT
