FBUTL5 ;WOIFO/SAB-FEE BASIS UTILITY ;7/6/2003
;;3.5;FEE BASIS;**61,135**;JAN 30, 1995;Build 3
Q
FPPSC(FBEDIT,FBFPPSC) ; Prompt EDI Claim and FPPS Claim ID Extrinsic Function
; Input
; FBEDIT - optional, true (=1) when editing an existing item
; FBFPPSC - optional, current value of FPPS CLAIM ID
; only passed when editing an existing item
; Return value (FBRET)
; = FPPS CLAIM ID if EDI Claim
; = null if not EDI Claim
; = -1 if time-out or '^'
;
N FBEDI,FBRET
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=""
;
ASKEDI ; ask if claim is an EDI claim
S DIR(0)="Y"
S DIR("A")="Is this an EDI Claim from the FPPS system"
I $G(FBEDIT) S DIR("B")=$S($G(FBFPPSC)]"":"YES",1:"NO")
D ^DIR K DIR I $D(DIRUT) S FBRET=-1 G FPPSCX
S FBEDI=Y
;
ASKID ; If EDI then ask claim ID
I FBEDI D I $D(DTOUT)!$D(DUOUT) S FBRET=-1 G FPPSCX
. N DA
. S DIR(0)="162.7,32"
. I $G(FBFPPSC)]"" S DIR("B")=FBFPPSC
. D ^DIR K DIR Q:$D(DIRUT)
. S FBRET=Y
;
; If EDI and claim ID not entered then reask
I FBEDI,FBRET="" D G ASKEDI
. W $C(7),!," The FPPS CLAIM ID must be entered for EDI claims!"
;
FPPSCX ; FPPSC Exit
I FBRET'="-1" D ; EDIT UCID FB3.5*135
. N XQOPT
. D OP^XQCHK I $P(XQOPT,U,1)'="FBAA EDIT PAYMENT" Q
. D EDITOUTP^FBUTL136(.FBRET,.DA) Q
Q FBRET
;
FPPSL(FBFPPSL,FBALL,FBNOOUT) ; Prompt FPPS Line Item Extrinsic Function
; Input
; FBFPPSL - optional, current value of FPPS LINE ITEM
; only passed when editing an existing item
; FBALL - optional, true (=1) if ALL allowed as input value,
; default is false
; FBNOOUT - optional, boolean value, default 0, set =1 if user
; should not be allowed to exit using an uparrow
; Return value (FBRET)
; = FPPS LINE ITEM
; = -1 if time-out or '^'
;
N FBRET
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=""
S FBNOOUT=$G(FBNOOUT,0)
S FBALL=$G(FBALL,0)
;
ASKLI ; ask line item
I FBALL D G:FBRET]"" FPPSLX I $D(DIRUT) S FBRET=-1 G FPPSLX
. S FBRET=""
. S DIR(0)="Y"
. S DIR("A")="Does this VistA invoice cover all line items on the FPPS Claim"
. I $G(FBFPPSL)]"" S DIR("B")=$S(FBFPPSL="ALL":"YES",1:"NO")
. D ^DIR K DIR Q:$D(DIRUT)
. I Y S FBRET="ALL"
;
S DIR(0)="LCA^1:999:0"
S DIR("A")="FPPS LINE ITEM: "
S DIR("?")="This response must be a number or a list or range, e.g., 1,3,5 or 2-4,8."
S DIR("??")="^D LIHLP^FBUTL5"
I $G(FBFPPSL)]"",FBFPPSL'="ALL" S DIR("B")=FBFPPSL
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S FBRET=-1 G FPPSLX
S FBRET=Y
;
FPPSLX ; FPPSL Exit
I FBNOOUT,FBRET=-1 D G ASKLI
. W !,"'^' NOT ALLOWED"
; strip trailing comma if any
I $E(FBRET,$L(FBRET))="," S FBRET=$E(FBRET,1,$L(FBRET)-1)
Q FBRET
;
LIHLP ; Line Item ?? Help
W !,"Enter the line item sequence number associated with this charge. Each"
W !,"charge on the FPPS invoice document will have a line item sequence number"
W !,"associated with it. A line item can be entered individually or a group of"
W !,"charges from multiple lines can be entered. If all line items in a group"
W !,"are in numerical sequence, you may enter the first line item sequence"
W !,"number followed by a hyphen and the last line item sequence number. If"
W !,"the grouped charges are not in sequential order, each line item must be"
W !,"entered individually, followed by a comma."
W !
Q
ASKPAN() ; Ask Patient Account Number Extrinsic Function
; Return value (FBRET)
; = PATIENT ACCOUNT NUMBER (if entered)
; = null if value not entered
; = '^' if time-out or '^'
N FBRET
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=""
S DIR(0)="162.03,49"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S FBRET="^"
I '$D(DIRUT) S FBRET=Y
Q FBRET
;
ASKREVC() ; Ask Revenue Code Extrinsic Function
; Return value (FBRET)
; = REVENUE CODE, internal pointer value (if entered)
; = null if value not entered
; = '^' if time-out or '^'
N FBRET
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=""
S DIR(0)="162.03,48"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S FBRET="^"
I '$D(DIRUT) S FBRET=+Y
Q FBRET
;
ASKUNITS() ; Ask Units Paid Extrinsic Function
; Return value (FBRET)
; = UNITS PAID (if entered)
; = null if value not entered
; = '^' if time-out or '^'
N FBRET
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=""
S DIR(0)="162.03,47"
S DIR("B")=1
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S FBRET="^"
I '$D(DIRUT) S FBRET=Y
Q FBRET
;
ASKPCN() ; Ask Patient Control Number Extrinsic Function
; Return value (FBRET)
; = PATIENT ACCOUNT NUMBER (if entered)
; = null if value not entered
; = '^' if time-out or '^'
N FBRET
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S FBRET=""
S DIR(0)="162.5,55"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S FBRET="^"
I '$D(DIRUT) S FBRET=Y
Q FBRET
;
;FBUTL5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUTL5 4905 printed Sep 23, 2025@19:36:52 Page 2
FBUTL5 ;WOIFO/SAB-FEE BASIS UTILITY ;7/6/2003
+1 ;;3.5;FEE BASIS;**61,135**;JAN 30, 1995;Build 3
+2 QUIT
FPPSC(FBEDIT,FBFPPSC) ; Prompt EDI Claim and FPPS Claim ID Extrinsic Function
+1 ; Input
+2 ; FBEDIT - optional, true (=1) when editing an existing item
+3 ; FBFPPSC - optional, current value of FPPS CLAIM ID
+4 ; only passed when editing an existing item
+5 ; Return value (FBRET)
+6 ; = FPPS CLAIM ID if EDI Claim
+7 ; = null if not EDI Claim
+8 ; = -1 if time-out or '^'
+9 ;
+10 NEW FBEDI,FBRET
+11 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+12 SET FBRET=""
+13 ;
ASKEDI ; ask if claim is an EDI claim
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Is this an EDI Claim from the FPPS system"
+3 IF $GET(FBEDIT)
SET DIR("B")=$SELECT($GET(FBFPPSC)]"":"YES",1:"NO")
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBRET=-1
GOTO FPPSCX
+5 SET FBEDI=Y
+6 ;
ASKID ; If EDI then ask claim ID
+1 IF FBEDI
Begin DoDot:1
+2 NEW DA
+3 SET DIR(0)="162.7,32"
+4 IF $GET(FBFPPSC)]""
SET DIR("B")=FBFPPSC
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+6 SET FBRET=Y
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)
SET FBRET=-1
GOTO FPPSCX
+7 ;
+8 ; If EDI and claim ID not entered then reask
+9 IF FBEDI
IF FBRET=""
Begin DoDot:1
+10 WRITE $CHAR(7),!," The FPPS CLAIM ID must be entered for EDI claims!"
End DoDot:1
GOTO ASKEDI
+11 ;
FPPSCX ; FPPSC Exit
+1 ; EDIT UCID FB3.5*135
IF FBRET'="-1"
Begin DoDot:1
+2 NEW XQOPT
+3 DO OP^XQCHK
IF $PIECE(XQOPT,U,1)'="FBAA EDIT PAYMENT"
QUIT
+4 DO EDITOUTP^FBUTL136(.FBRET,.DA)
QUIT
End DoDot:1
+5 QUIT FBRET
+6 ;
FPPSL(FBFPPSL,FBALL,FBNOOUT) ; Prompt FPPS Line Item Extrinsic Function
+1 ; Input
+2 ; FBFPPSL - optional, current value of FPPS LINE ITEM
+3 ; only passed when editing an existing item
+4 ; FBALL - optional, true (=1) if ALL allowed as input value,
+5 ; default is false
+6 ; FBNOOUT - optional, boolean value, default 0, set =1 if user
+7 ; should not be allowed to exit using an uparrow
+8 ; Return value (FBRET)
+9 ; = FPPS LINE ITEM
+10 ; = -1 if time-out or '^'
+11 ;
+12 NEW FBRET
+13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+14 SET FBRET=""
+15 SET FBNOOUT=$GET(FBNOOUT,0)
+16 SET FBALL=$GET(FBALL,0)
+17 ;
ASKLI ; ask line item
+1 IF FBALL
Begin DoDot:1
+2 SET FBRET=""
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Does this VistA invoice cover all line items on the FPPS Claim"
+5 IF $GET(FBFPPSL)]""
SET DIR("B")=$SELECT(FBFPPSL="ALL":"YES",1:"NO")
+6 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+7 IF Y
SET FBRET="ALL"
End DoDot:1
if FBRET]""
GOTO FPPSLX
IF $DATA(DIRUT)
SET FBRET=-1
GOTO FPPSLX
+8 ;
+9 SET DIR(0)="LCA^1:999:0"
+10 SET DIR("A")="FPPS LINE ITEM: "
+11 SET DIR("?")="This response must be a number or a list or range, e.g., 1,3,5 or 2-4,8."
+12 SET DIR("??")="^D LIHLP^FBUTL5"
+13 IF $GET(FBFPPSL)]""
IF FBFPPSL'="ALL"
SET DIR("B")=FBFPPSL
+14 DO ^DIR
KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
SET FBRET=-1
GOTO FPPSLX
+16 SET FBRET=Y
+17 ;
FPPSLX ; FPPSL Exit
+1 IF FBNOOUT
IF FBRET=-1
Begin DoDot:1
+2 WRITE !,"'^' NOT ALLOWED"
End DoDot:1
GOTO ASKLI
+3 ; strip trailing comma if any
+4 IF $EXTRACT(FBRET,$LENGTH(FBRET))=","
SET FBRET=$EXTRACT(FBRET,1,$LENGTH(FBRET)-1)
+5 QUIT FBRET
+6 ;
LIHLP ; Line Item ?? Help
+1 WRITE !,"Enter the line item sequence number associated with this charge. Each"
+2 WRITE !,"charge on the FPPS invoice document will have a line item sequence number"
+3 WRITE !,"associated with it. A line item can be entered individually or a group of"
+4 WRITE !,"charges from multiple lines can be entered. If all line items in a group"
+5 WRITE !,"are in numerical sequence, you may enter the first line item sequence"
+6 WRITE !,"number followed by a hyphen and the last line item sequence number. If"
+7 WRITE !,"the grouped charges are not in sequential order, each line item must be"
+8 WRITE !,"entered individually, followed by a comma."
+9 WRITE !
+10 QUIT
ASKPAN() ; Ask Patient Account Number Extrinsic Function
+1 ; Return value (FBRET)
+2 ; = PATIENT ACCOUNT NUMBER (if entered)
+3 ; = null if value not entered
+4 ; = '^' if time-out or '^'
+5 NEW FBRET
+6 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 SET FBRET=""
+8 SET DIR(0)="162.03,49"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
SET FBRET="^"
+11 IF '$DATA(DIRUT)
SET FBRET=Y
+12 QUIT FBRET
+13 ;
ASKREVC() ; Ask Revenue Code Extrinsic Function
+1 ; Return value (FBRET)
+2 ; = REVENUE CODE, internal pointer value (if entered)
+3 ; = null if value not entered
+4 ; = '^' if time-out or '^'
+5 NEW FBRET
+6 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 SET FBRET=""
+8 SET DIR(0)="162.03,48"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
SET FBRET="^"
+11 IF '$DATA(DIRUT)
SET FBRET=+Y
+12 QUIT FBRET
+13 ;
ASKUNITS() ; Ask Units Paid Extrinsic Function
+1 ; Return value (FBRET)
+2 ; = UNITS PAID (if entered)
+3 ; = null if value not entered
+4 ; = '^' if time-out or '^'
+5 NEW FBRET
+6 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 SET FBRET=""
+8 SET DIR(0)="162.03,47"
+9 SET DIR("B")=1
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
SET FBRET="^"
+12 IF '$DATA(DIRUT)
SET FBRET=Y
+13 QUIT FBRET
+14 ;
ASKPCN() ; Ask Patient Control Number Extrinsic Function
+1 ; Return value (FBRET)
+2 ; = PATIENT ACCOUNT NUMBER (if entered)
+3 ; = null if value not entered
+4 ; = '^' if time-out or '^'
+5 NEW FBRET
+6 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 SET FBRET=""
+8 SET DIR(0)="162.5,55"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
SET FBRET="^"
+11 IF '$DATA(DIRUT)
SET FBRET=Y
+12 QUIT FBRET
+13 ;
+14 ;FBUTL5
