VistA-FOIAVistA/r/FEE_BASIS-FB/FBUTL1.m

151 lines
5.2 KiB
Mathematica

FBUTL1 ;WOIFO/SAB-FEE BASIS UTILITY ;6/17/2003
;;3.5;FEE BASIS;**61**;JAN 30, 1995
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
; 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) ; 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
S FBRET="",FBERR=""
I $G(FBAR)]"" K @FBAR
;
; 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) ; 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
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
;
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