Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBUTL4

FBUTL4.m

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