FBUTL1 ;WOIFO/SAB-FEE BASIS UTILITY ;6/17/2003
;;3.5;FEE BASIS;**61,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
Q
;Extrinsic functions AR, AG, and RR have similar inputs and outputs
; input
; FBCI - Internal entry number of code.
; Not required if external value is passed.
; FBCE - External value of code.
; Not required if internal value is passed.
; If both the internal and external values are passed
; then the external value will be ignored.
; FBDT - Effective date.
; Optional - DT (Today) will be used if a value is not passed.
; An input date prior to 6/1/03 will be changed to be 6/1/03.
; FBAR - Root of local or global array in which the description
; word processing field will be returned.
; Optional - description will not be returned if an array root
; is not passed. The root should be in closed format
; such as FBAR or FBAR(2) or ^TMP($J,"DESC").
; The root should not be a variable name already used in FBUTL1
; FBCORE - Optional value indicating the CORE Scenario to use when
; displaying lists of CARCs. Only related CARCs will list.
; Returns a string value
; Internal code ^ External code ^ HIPAA status ^ FEE status ^ name
; OR if there is an error
; -1^-1^^^error message text
; where
; internal code = internal entry number of code in file
; external code = external value of code
; HIPAA status = 1 (active) or 0 (inactive) as of effective date
; FEE status = 1 (applicable) or 0 (not applicable) for fee claim
; adjudication as of the effective date
; name = a short descriptive name for the code as of the eff. date
; name is only returned by AG (not returned by AR and RR)
; error message text = an error message
; Output
; fbarr( - Array containing the description as of the effective date.
; For example, if "FBTXT" was passed in parameter FBAR then
; the output might be
; FBTXT(1)=1st line of description
; FBTXT(2)=2nd line of description
; The array will be undefined if there is not a description
;
AR(FBCI,FBCE,FBDT,FBAR,FBCORE) ; ADJUSTMENT REASON extrinsic function
; Provides status and description for an adjustment reason code
; stored in the ADJUSTMENT REASON (#161.91) file.
; see top of routine for additional documentation
N FBC,FBDT1,FBERR,FBRET,FBCORE2
S FBRET="",FBERR=""
I $G(FBAR)]"" K @FBAR
S (FBCORE,FBCORE2)=$G(FBCORE)
I FBCORE D
. I $G(FBCI)="",$G(FBCE)]"" S FBCI=$O(^FB(161.91,"B",FBCE,0))
. I $G(FBCI) S FBCORE2=$P($G(^FB(161.91,FBCI,0)),U,3)
I FBCORE]"",FBCORE'=FBCORE2 Q "^^^0"
;
; find code in file
D FNDCDE(161.91)
;
; set effective date for search
D SETDT
;
; determine status of code
I FBCI,FBERR="" D GETSTAT(161.91)
;
; if array root passed then determine description of code
I $G(FBAR)]"",FBCI,FBERR="" D GETDESC(161.91)
;
I FBERR]"" S FBRET="-1^-1^^^"_FBERR
Q FBRET
;
AG(FBCI,FBCE,FBDT,FBAR) ; ADJUSTMENT GROUP extrinsic function
; Provides status and description for an adjustment group code
; stored in the ADJUSTMENT GROUP (#161.92) file.
; see top of routine for additional documentation
N FBC,FBDT1,FBERR,FBRET
S FBRET="",FBERR=""
I $G(FBAR)]"" K @FBAR
;
; find code in file
D FNDCDE(161.92)
;
; set effective date for search
D SETDT
;
; determine status of code
I FBCI,FBERR="" D GETSTAT(161.92)
;
; determine name, description of code
I FBCI,FBERR="" D GETDESC(161.92)
;
I FBERR]"" S FBRET="-1^-1^^^"_FBERR
Q FBRET
;
RR(FBCI,FBCE,FBDT,FBAR,FBADJ) ; REMITTANCE REMARK extrinsic function
; Provides status and description for an adjustment reason code
; stored in the REMITTANCE REMARK (#161.93) file.
; see top of routine for additional documentation
N FBC,FBDT1,FBERR,FBRET
S FBRET="",FBERR=""
I $G(FBAR)]"" K @FBAR
;
; find code in file
I $G(FBADJ) D FNDRARC(FBCI,FBADJ)
E D FNDCDE(161.93)
;
; set effective date for search
D SETDT
;
; determine status of code
I FBCI,FBERR="" D GETSTAT(161.93)
;
; if array root passed then determine description of code
I $G(FBAR)]"",FBCI,FBERR="" D GETDESC(161.93)
;
I FBERR]"" S FBRET="-1^-1^^^"_FBERR
Q FBRET
;
FNDCDE(FBFILE) ; find code
; determine ien if not passed
I $G(FBCI)="",$G(FBCE)]"" S FBCI=$O(^FB(FBFILE,"B",FBCE,0))
; get data
I $G(FBCI) S FBC=$P($G(^FB(FBFILE,FBCI,0)),U)
I $G(FBC)="" S FBERR="CODE NOT FOUND IN FILE"
E S FBRET=FBCI_U_FBC
Q
;
FNDRARC(FBCI,FBADJ) ; find RARC in Adjustment Reason sub-file
;
I $D(^FB(161.91,FBADJ,"RARC")) D
. I $G(FBCI),$D(^FB(161.91,FBADJ,"RARC","B",FBCI)) D
. . S FBC=$P($G(^FB(161.93,FBCI,0)),U)
. . S FBRET=FBCI_U_FBC
. E S FBERR="CODE NOT FOUND IN FILE"
E D FNDCDE(161.93)
Q
;
SETDT ; set date
I $G(FBDT)'?7N S FBDT=DT ; if date not passed then set as Today
I FBDT<3030601 S FBDT=3030601 ; if date prior to 6/1/03 then set
S FBDT1=$$FMADD^XLFDT(FBDT,1) ; use date + 1 in reverse $Orders
Q
;
GETSTAT(FBFILE) ; get status
N FBFEEU,FBSEDT,FBSI,FBSTAT,FBSY
; find most recent status effective date prior to the input date
S FBSEDT=$O(^FB(FBFILE,FBCI,1,"B",FBDT1),-1)
S:FBSEDT]"" FBSI=$O(^FB(FBFILE,FBCI,1,"B",FBSEDT,0))
S:$G(FBSI) FBSY=$G(^FB(FBFILE,FBCI,1,FBSI,0))
S:$G(FBSY)]"" FBSTAT=$P(FBSY,U,2),FBFEEU=$S('FBSTAT:0,1:+$P(FBSY,U,3))
I $G(FBSTAT)="" S FBERR="STATUS NOT AVAILABLE FOR SPECIFIED DATE" Q
S FBRET=FBRET_U_FBSTAT_U_FBFEEU
Q
;
GETDESC(FBFILE) ; get description
N FBDEDT,FBDI,FBDN,FBX
; find most recent description effective date prior to input date
S FBDEDT=$O(^FB(FBFILE,FBCI,2,"B",FBDT1),-1)
S:FBDEDT]"" FBDI=$O(^FB(FBFILE,FBCI,2,"B",FBDEDT,0))
; if file 161.92 then get short descriptive name
I FBFILE=161.92 D
. S:$G(FBDI) FBDN=$P($G(^FB(FBFILE,FBCI,2,FBDI,0)),U,2)
. S FBRET=FBRET_U_$G(FBDN)
; if array root passed then get full description
I $G(FBAR)]"",$G(FBDI) S FBX=$$GET1^DIQ(FBFILE_"2",FBDI_","_FBCI_",",1,,FBAR)
Q
;
;FBUTL1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUTL1 6239 printed Apr 09, 2024@21:03:44 Page 2
FBUTL1 ;WOIFO/SAB-FEE BASIS UTILITY ;6/17/2003
+1 ;;3.5;FEE BASIS;**61,158**;JAN 30, 1995;Build 94
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;Extrinsic functions AR, AG, and RR have similar inputs and outputs
+5 ; input
+6 ; FBCI - Internal entry number of code.
+7 ; Not required if external value is passed.
+8 ; FBCE - External value of code.
+9 ; Not required if internal value is passed.
+10 ; If both the internal and external values are passed
+11 ; then the external value will be ignored.
+12 ; FBDT - Effective date.
+13 ; Optional - DT (Today) will be used if a value is not passed.
+14 ; An input date prior to 6/1/03 will be changed to be 6/1/03.
+15 ; FBAR - Root of local or global array in which the description
+16 ; word processing field will be returned.
+17 ; Optional - description will not be returned if an array root
+18 ; is not passed. The root should be in closed format
+19 ; such as FBAR or FBAR(2) or ^TMP($J,"DESC").
+20 ; The root should not be a variable name already used in FBUTL1
+21 ; FBCORE - Optional value indicating the CORE Scenario to use when
+22 ; displaying lists of CARCs. Only related CARCs will list.
+23 ; Returns a string value
+24 ; Internal code ^ External code ^ HIPAA status ^ FEE status ^ name
+25 ; OR if there is an error
+26 ; -1^-1^^^error message text
+27 ; where
+28 ; internal code = internal entry number of code in file
+29 ; external code = external value of code
+30 ; HIPAA status = 1 (active) or 0 (inactive) as of effective date
+31 ; FEE status = 1 (applicable) or 0 (not applicable) for fee claim
+32 ; adjudication as of the effective date
+33 ; name = a short descriptive name for the code as of the eff. date
+34 ; name is only returned by AG (not returned by AR and RR)
+35 ; error message text = an error message
+36 ; Output
+37 ; fbarr( - Array containing the description as of the effective date.
+38 ; For example, if "FBTXT" was passed in parameter FBAR then
+39 ; the output might be
+40 ; FBTXT(1)=1st line of description
+41 ; FBTXT(2)=2nd line of description
+42 ; The array will be undefined if there is not a description
+43 ;
AR(FBCI,FBCE,FBDT,FBAR,FBCORE) ; ADJUSTMENT REASON extrinsic function
+1 ; Provides status and description for an adjustment reason code
+2 ; stored in the ADJUSTMENT REASON (#161.91) file.
+3 ; see top of routine for additional documentation
+4 NEW FBC,FBDT1,FBERR,FBRET,FBCORE2
+5 SET FBRET=""
SET FBERR=""
+6 IF $GET(FBAR)]""
KILL @FBAR
+7 SET (FBCORE,FBCORE2)=$GET(FBCORE)
+8 IF FBCORE
Begin DoDot:1
+9 IF $GET(FBCI)=""
IF $GET(FBCE)]""
SET FBCI=$ORDER(^FB(161.91,"B",FBCE,0))
+10 IF $GET(FBCI)
SET FBCORE2=$PIECE($GET(^FB(161.91,FBCI,0)),U,3)
End DoDot:1
+11 IF FBCORE]""
IF FBCORE'=FBCORE2
QUIT "^^^0"
+12 ;
+13 ; find code in file
+14 DO FNDCDE(161.91)
+15 ;
+16 ; set effective date for search
+17 DO SETDT
+18 ;
+19 ; determine status of code
+20 IF FBCI
IF FBERR=""
DO GETSTAT(161.91)
+21 ;
+22 ; if array root passed then determine description of code
+23 IF $GET(FBAR)]""
IF FBCI
IF FBERR=""
DO GETDESC(161.91)
+24 ;
+25 IF FBERR]""
SET FBRET="-1^-1^^^"_FBERR
+26 QUIT FBRET
+27 ;
AG(FBCI,FBCE,FBDT,FBAR) ; ADJUSTMENT GROUP extrinsic function
+1 ; Provides status and description for an adjustment group code
+2 ; stored in the ADJUSTMENT GROUP (#161.92) file.
+3 ; see top of routine for additional documentation
+4 NEW FBC,FBDT1,FBERR,FBRET
+5 SET FBRET=""
SET FBERR=""
+6 IF $GET(FBAR)]""
KILL @FBAR
+7 ;
+8 ; find code in file
+9 DO FNDCDE(161.92)
+10 ;
+11 ; set effective date for search
+12 DO SETDT
+13 ;
+14 ; determine status of code
+15 IF FBCI
IF FBERR=""
DO GETSTAT(161.92)
+16 ;
+17 ; determine name, description of code
+18 IF FBCI
IF FBERR=""
DO GETDESC(161.92)
+19 ;
+20 IF FBERR]""
SET FBRET="-1^-1^^^"_FBERR
+21 QUIT FBRET
+22 ;
RR(FBCI,FBCE,FBDT,FBAR,FBADJ) ; REMITTANCE REMARK extrinsic function
+1 ; Provides status and description for an adjustment reason code
+2 ; stored in the REMITTANCE REMARK (#161.93) file.
+3 ; see top of routine for additional documentation
+4 NEW FBC,FBDT1,FBERR,FBRET
+5 SET FBRET=""
SET FBERR=""
+6 IF $GET(FBAR)]""
KILL @FBAR
+7 ;
+8 ; find code in file
+9 IF $GET(FBADJ)
DO FNDRARC(FBCI,FBADJ)
+10 IF '$TEST
DO FNDCDE(161.93)
+11 ;
+12 ; set effective date for search
+13 DO SETDT
+14 ;
+15 ; determine status of code
+16 IF FBCI
IF FBERR=""
DO GETSTAT(161.93)
+17 ;
+18 ; if array root passed then determine description of code
+19 IF $GET(FBAR)]""
IF FBCI
IF FBERR=""
DO GETDESC(161.93)
+20 ;
+21 IF FBERR]""
SET FBRET="-1^-1^^^"_FBERR
+22 QUIT FBRET
+23 ;
FNDCDE(FBFILE) ; find code
+1 ; determine ien if not passed
+2 IF $GET(FBCI)=""
IF $GET(FBCE)]""
SET FBCI=$ORDER(^FB(FBFILE,"B",FBCE,0))
+3 ; get data
+4 IF $GET(FBCI)
SET FBC=$PIECE($GET(^FB(FBFILE,FBCI,0)),U)
+5 IF $GET(FBC)=""
SET FBERR="CODE NOT FOUND IN FILE"
+6 IF '$TEST
SET FBRET=FBCI_U_FBC
+7 QUIT
+8 ;
FNDRARC(FBCI,FBADJ) ; find RARC in Adjustment Reason sub-file
+1 ;
+2 IF $DATA(^FB(161.91,FBADJ,"RARC"))
Begin DoDot:1
+3 IF $GET(FBCI)
IF $DATA(^FB(161.91,FBADJ,"RARC","B",FBCI))
Begin DoDot:2
+4 SET FBC=$PIECE($GET(^FB(161.93,FBCI,0)),U)
+5 SET FBRET=FBCI_U_FBC
End DoDot:2
+6 IF '$TEST
SET FBERR="CODE NOT FOUND IN FILE"
End DoDot:1
+7 IF '$TEST
DO FNDCDE(161.93)
+8 QUIT
+9 ;
SETDT ; set date
+1 ; if date not passed then set as Today
IF $GET(FBDT)'?7N
SET FBDT=DT
+2 ; if date prior to 6/1/03 then set
IF FBDT<3030601
SET FBDT=3030601
+3 ; use date + 1 in reverse $Orders
SET FBDT1=$$FMADD^XLFDT(FBDT,1)
+4 QUIT
+5 ;
GETSTAT(FBFILE) ; get status
+1 NEW FBFEEU,FBSEDT,FBSI,FBSTAT,FBSY
+2 ; find most recent status effective date prior to the input date
+3 SET FBSEDT=$ORDER(^FB(FBFILE,FBCI,1,"B",FBDT1),-1)
+4 if FBSEDT]""
SET FBSI=$ORDER(^FB(FBFILE,FBCI,1,"B",FBSEDT,0))
+5 if $GET(FBSI)
SET FBSY=$GET(^FB(FBFILE,FBCI,1,FBSI,0))
+6 if $GET(FBSY)]""
SET FBSTAT=$PIECE(FBSY,U,2)
SET FBFEEU=$SELECT('FBSTAT:0,1:+$PIECE(FBSY,U,3))
+7 IF $GET(FBSTAT)=""
SET FBERR="STATUS NOT AVAILABLE FOR SPECIFIED DATE"
QUIT
+8 SET FBRET=FBRET_U_FBSTAT_U_FBFEEU
+9 QUIT
+10 ;
GETDESC(FBFILE) ; get description
+1 NEW FBDEDT,FBDI,FBDN,FBX
+2 ; find most recent description effective date prior to input date
+3 SET FBDEDT=$ORDER(^FB(FBFILE,FBCI,2,"B",FBDT1),-1)
+4 if FBDEDT]""
SET FBDI=$ORDER(^FB(FBFILE,FBCI,2,"B",FBDEDT,0))
+5 ; if file 161.92 then get short descriptive name
+6 IF FBFILE=161.92
Begin DoDot:1
+7 if $GET(FBDI)
SET FBDN=$PIECE($GET(^FB(FBFILE,FBCI,2,FBDI,0)),U,2)
+8 SET FBRET=FBRET_U_$GET(FBDN)
End DoDot:1
+9 ; if array root passed then get full description
+10 IF $GET(FBAR)]""
IF $GET(FBDI)
SET FBX=$$GET1^DIQ(FBFILE_"2",FBDI_","_FBCI_",",1,,FBAR)
+11 QUIT
+12 ;
+13 ;FBUTL1
