153 lines
5.4 KiB
Mathematica
153 lines
5.4 KiB
Mathematica
|
FBUTL4 ;WOIFO/SAB-FEE BASIS UTILITY ;7/6/2003
|
||
|
;;3.5;FEE BASIS;**61**;JAN 30, 1995
|
||
|
Q
|
||
|
RR(FBRRMK,FBMAX,FBDT,FBRRMKD) ; Prompt for Remittance Remarks
|
||
|
;
|
||
|
; Input
|
||
|
; FBRRMK - required, array passed by reference
|
||
|
; will be initialized (killed)
|
||
|
; array of any entered remark codes
|
||
|
; format
|
||
|
; FBRRMK(#)=FBRRMKC
|
||
|
; where
|
||
|
; # = sequentially assigned number starting with 1
|
||
|
; FBRRMKC = remittance remark (internal value file 162.93)
|
||
|
; FBMAX - optional, number, default to 2
|
||
|
; maximum number of remarks that may be entered by user
|
||
|
; FBDT - optional, effective date, FileMan internal format
|
||
|
; default to current date, used to determine available codes
|
||
|
; FBRRMKD- optional, array passed by reference
|
||
|
; same format as FBRRMK
|
||
|
; if passed, it will be used to supply default values
|
||
|
; normally only used when editing an existing payment
|
||
|
; Result (value of $$RR extrinsic function)
|
||
|
; FBRET - boulean value (0 or 1)
|
||
|
; = 1 when process did not end due to time-out or "^"
|
||
|
; = 0 when process ended due to time-out OR "^"
|
||
|
; Output
|
||
|
; FBRRMK- the FBRRMK input array passed by reference will be modified
|
||
|
; it will contain any entered remarks
|
||
|
;
|
||
|
N FBRRMKC,FBCNT,FBEDIT,FBERR,FBI,FBNEW,FBRET
|
||
|
N DIR,DIRUT,DTOUT,DUOUT,X,Y
|
||
|
S FBRET=1
|
||
|
S FBMAX=$G(FBMAX,2)
|
||
|
S FBDT=$G(FBDT,DT)
|
||
|
K FBRRMK
|
||
|
;
|
||
|
; if default remarks exist then load them into array
|
||
|
I $D(FBRRMKD) M FBRRMK=FBRRMKD
|
||
|
S FBCNT=0
|
||
|
I $D(FBRRMK) S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI S FBCNT=FBCNT+1
|
||
|
;
|
||
|
ASKRR ; multiply prompt for remarks
|
||
|
;
|
||
|
; display current list of remarks when more than 1 allowed
|
||
|
I FBMAX>1!(FBCNT>1) D
|
||
|
. W !!,"Current list of Remittance Remarks: "
|
||
|
. I '$O(FBRRMK(0)) W "none"
|
||
|
. S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D
|
||
|
. . W:$P(FBRRMK(FBI),U)]"" $P($G(^FB(161.93,$P(FBRRMK(FBI),U),0)),U),", "
|
||
|
. W !
|
||
|
;
|
||
|
; prompt for remark
|
||
|
; if max is 1 and reason already on list then automatically select it
|
||
|
I FBMAX=1,FBCNT=1 D
|
||
|
. N FBI,FBRRMKC
|
||
|
. S FBI=$O(FBRRMK(0))
|
||
|
. S:FBI FBRRMKC=$P(FBRRMK(FBI),U)
|
||
|
. I FBRRMKC S Y=FBRRMKC_U_$P($G(^FB(161.93,FBRRMKC,0)),U)
|
||
|
E D I $D(DTOUT)!$D(DUOUT) S FBRET=0 G EXIT ; prompt user
|
||
|
. S DIR(0)="PO^161.93:EMZ"
|
||
|
. S DIR("A")="Select REMITTANCE REMARK"
|
||
|
. S DIR("S")="I $P($$RR^FBUTL1(Y,,FBDT),U,4)=1"
|
||
|
. S DIR("?")="Select a HIPAA Remittance Remark Code."
|
||
|
. S DIR("?",1)="Select a remittance remark code to provide non-financial"
|
||
|
. S DIR("?",2)="information critical to understanding the adjudication of the claim."
|
||
|
. D ^DIR K DIR
|
||
|
;
|
||
|
; if value was entered then process it and ask another if not max
|
||
|
;I +Y>0 D G:FBRET=0 EXIT I FBCNT<FBMAX!(FBRRMKC="") G ASKRR
|
||
|
I +Y>0 D G:FBRET=0 EXIT G ASKRR
|
||
|
. S FBRRMKC=+Y
|
||
|
. ; if specified remark already in list set FBEDIT = it's number
|
||
|
. S (FBI,FBEDIT)=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D Q:FBEDIT
|
||
|
. . I $P(FBRRMK(FBI),U)=FBRRMKC S FBEDIT=FBI
|
||
|
. S FBNEW=$S(FBEDIT:0,1:1) ; flag as new if not on list
|
||
|
. ; if in list then edit the existing remark
|
||
|
. I FBEDIT D Q:$D(DIRUT) Q:FBRRMKC=""
|
||
|
. . S DIR(0)="162.559,.01"
|
||
|
. . S DIR("B")=$P($G(^FB(161.93,FBRRMKC,0)),U)
|
||
|
. . D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S:FBMAX=1 FBRET=0 Q
|
||
|
. . I X="@" D Q ; "@" removes from list
|
||
|
. . . D DEL(FBEDIT)
|
||
|
. . I +Y>0 S FBRRMKC=+Y
|
||
|
. . ; ensure new value of edited remark is not already on list
|
||
|
. . S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D Q:FBRRMKC=""
|
||
|
. . . I $P(FBRRMK(FBI),U)=FBRRMKC,FBI'=FBEDIT S FBRRMKC="" W !,$C(7)," Change was not accepted because the new value is already on the list."
|
||
|
. . Q:FBRRMKC=""
|
||
|
. . ; upate the existing reason
|
||
|
. . S $P(FBRRMK(FBEDIT),U)=FBRRMKC
|
||
|
. ;
|
||
|
. ; if new reason then add to list
|
||
|
. I 'FBEDIT D Q:FBRRMKC=""
|
||
|
. . I (FBCNT+1)>FBMAX D Q
|
||
|
. . . S FBRRMKC=""
|
||
|
. . . W !!,$C(7),"ERROR: A new reason would exceed maximum number (",FBMAX,") allowed for this invoice."
|
||
|
. . . W !," If necessary, a code on the current list can be selected and changed."
|
||
|
. . S FBEDIT=$O(FBRRMK(" "),-1)+1
|
||
|
. . S $P(FBRRMK(FBEDIT),U)=FBRRMKC,FBCNT=FBCNT+1
|
||
|
;
|
||
|
; validate
|
||
|
I FBCNT>FBMAX D G ASKRR
|
||
|
. W !!,$C(7),"ERROR: Maximum number of remittance remark codes (",FBMAX,") have been exceeded."
|
||
|
;
|
||
|
EXIT ;
|
||
|
Q FBRET
|
||
|
;
|
||
|
DEL(FBI) ; delete remark from list
|
||
|
S FBCNT=FBCNT-1
|
||
|
K FBRRMK(FBI)
|
||
|
S FBRRMKC=""
|
||
|
W " (deleted)"
|
||
|
Q
|
||
|
;
|
||
|
RRL(FBRRMK) ; build list of remittance remarks extrinsic function
|
||
|
; Input
|
||
|
; FBRRMK- required, array passed by reference
|
||
|
; array of remittance remarks
|
||
|
; format
|
||
|
; FBRRMK(#)=FBRRMKC
|
||
|
; where
|
||
|
; # = integer number greater than 0
|
||
|
; FBRRMKC = remittance remark (internal value file 162.93)
|
||
|
; Result
|
||
|
; string containing sorted list (by external code) of remarks
|
||
|
; format
|
||
|
; FBRRMKCE 1, FBRRMKCE 2
|
||
|
; where
|
||
|
; FBRRMKCE = remittance remark code (external value)
|
||
|
N FBRET
|
||
|
N FBRRMKC,FBRRMKCE
|
||
|
N FBRRMKS,FBI
|
||
|
S FBRET=""
|
||
|
;
|
||
|
; build sorted array containing external values
|
||
|
S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D
|
||
|
. ; obtain internal values
|
||
|
. S FBRRMKC=$P(FBRRMK(FBI),U)
|
||
|
. ; convert to external values
|
||
|
. S FBRRMKCE=$S(FBRRMKC:$P($G(^FB(161.93,FBRRMKC,0)),U),1:"")
|
||
|
. ; store in sorted array
|
||
|
. S FBRRMKS(FBRRMKCE_U_FBI)=FBRRMKCE_","
|
||
|
;
|
||
|
; build list from sorted array
|
||
|
S FBI="" F S FBI=$O(FBRRMKS(FBI)) Q:FBI="" D
|
||
|
. S FBRET=FBRET_FBRRMKS(FBI)
|
||
|
; strip trailing "," from list
|
||
|
I $E(FBRET,$L(FBRET))="," S FBRET=$E(FBRET,1,$L(FBRET)-1)
|
||
|
;
|
||
|
Q FBRET
|
||
|
;
|
||
|
;FBUTL4
|