source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBUTL4.m@ 1722

Last change on this file since 1722 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1FBUTL4 ;WOIFO/SAB-FEE BASIS UTILITY ;7/6/2003
2 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
3 Q
4RR(FBRRMK,FBMAX,FBDT,FBRRMKD) ; Prompt for Remittance Remarks
5 ;
6 ; Input
7 ; FBRRMK - required, array passed by reference
8 ; will be initialized (killed)
9 ; array of any entered remark codes
10 ; format
11 ; FBRRMK(#)=FBRRMKC
12 ; where
13 ; # = sequentially assigned number starting with 1
14 ; FBRRMKC = remittance remark (internal value file 162.93)
15 ; FBMAX - optional, number, default to 2
16 ; maximum number of remarks that may be entered by user
17 ; FBDT - optional, effective date, FileMan internal format
18 ; default to current date, used to determine available codes
19 ; FBRRMKD- optional, array passed by reference
20 ; same format as FBRRMK
21 ; if passed, it will be used to supply default values
22 ; normally only used when editing an existing payment
23 ; Result (value of $$RR extrinsic function)
24 ; FBRET - boulean value (0 or 1)
25 ; = 1 when process did not end due to time-out or "^"
26 ; = 0 when process ended due to time-out OR "^"
27 ; Output
28 ; FBRRMK- the FBRRMK input array passed by reference will be modified
29 ; it will contain any entered remarks
30 ;
31 N FBRRMKC,FBCNT,FBEDIT,FBERR,FBI,FBNEW,FBRET
32 N DIR,DIRUT,DTOUT,DUOUT,X,Y
33 S FBRET=1
34 S FBMAX=$G(FBMAX,2)
35 S FBDT=$G(FBDT,DT)
36 K FBRRMK
37 ;
38 ; if default remarks exist then load them into array
39 I $D(FBRRMKD) M FBRRMK=FBRRMKD
40 S FBCNT=0
41 I $D(FBRRMK) S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI S FBCNT=FBCNT+1
42 ;
43ASKRR ; multiply prompt for remarks
44 ;
45 ; display current list of remarks when more than 1 allowed
46 I FBMAX>1!(FBCNT>1) D
47 . W !!,"Current list of Remittance Remarks: "
48 . I '$O(FBRRMK(0)) W "none"
49 . S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D
50 . . W:$P(FBRRMK(FBI),U)]"" $P($G(^FB(161.93,$P(FBRRMK(FBI),U),0)),U),", "
51 . W !
52 ;
53 ; prompt for remark
54 ; if max is 1 and reason already on list then automatically select it
55 I FBMAX=1,FBCNT=1 D
56 . N FBI,FBRRMKC
57 . S FBI=$O(FBRRMK(0))
58 . S:FBI FBRRMKC=$P(FBRRMK(FBI),U)
59 . I FBRRMKC S Y=FBRRMKC_U_$P($G(^FB(161.93,FBRRMKC,0)),U)
60 E D I $D(DTOUT)!$D(DUOUT) S FBRET=0 G EXIT ; prompt user
61 . S DIR(0)="PO^161.93:EMZ"
62 . S DIR("A")="Select REMITTANCE REMARK"
63 . S DIR("S")="I $P($$RR^FBUTL1(Y,,FBDT),U,4)=1"
64 . S DIR("?")="Select a HIPAA Remittance Remark Code."
65 . S DIR("?",1)="Select a remittance remark code to provide non-financial"
66 . S DIR("?",2)="information critical to understanding the adjudication of the claim."
67 . D ^DIR K DIR
68 ;
69 ; if value was entered then process it and ask another if not max
70 ;I +Y>0 D G:FBRET=0 EXIT I FBCNT<FBMAX!(FBRRMKC="") G ASKRR
71 I +Y>0 D G:FBRET=0 EXIT G ASKRR
72 . S FBRRMKC=+Y
73 . ; if specified remark already in list set FBEDIT = it's number
74 . S (FBI,FBEDIT)=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D Q:FBEDIT
75 . . I $P(FBRRMK(FBI),U)=FBRRMKC S FBEDIT=FBI
76 . S FBNEW=$S(FBEDIT:0,1:1) ; flag as new if not on list
77 . ; if in list then edit the existing remark
78 . I FBEDIT D Q:$D(DIRUT) Q:FBRRMKC=""
79 . . S DIR(0)="162.559,.01"
80 . . S DIR("B")=$P($G(^FB(161.93,FBRRMKC,0)),U)
81 . . D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S:FBMAX=1 FBRET=0 Q
82 . . I X="@" D Q ; "@" removes from list
83 . . . D DEL(FBEDIT)
84 . . I +Y>0 S FBRRMKC=+Y
85 . . ; ensure new value of edited remark is not already on list
86 . . S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D Q:FBRRMKC=""
87 . . . 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."
88 . . Q:FBRRMKC=""
89 . . ; upate the existing reason
90 . . S $P(FBRRMK(FBEDIT),U)=FBRRMKC
91 . ;
92 . ; if new reason then add to list
93 . I 'FBEDIT D Q:FBRRMKC=""
94 . . I (FBCNT+1)>FBMAX D Q
95 . . . S FBRRMKC=""
96 . . . W !!,$C(7),"ERROR: A new reason would exceed maximum number (",FBMAX,") allowed for this invoice."
97 . . . W !," If necessary, a code on the current list can be selected and changed."
98 . . S FBEDIT=$O(FBRRMK(" "),-1)+1
99 . . S $P(FBRRMK(FBEDIT),U)=FBRRMKC,FBCNT=FBCNT+1
100 ;
101 ; validate
102 I FBCNT>FBMAX D G ASKRR
103 . W !!,$C(7),"ERROR: Maximum number of remittance remark codes (",FBMAX,") have been exceeded."
104 ;
105EXIT ;
106 Q FBRET
107 ;
108DEL(FBI) ; delete remark from list
109 S FBCNT=FBCNT-1
110 K FBRRMK(FBI)
111 S FBRRMKC=""
112 W " (deleted)"
113 Q
114 ;
115RRL(FBRRMK) ; build list of remittance remarks extrinsic function
116 ; Input
117 ; FBRRMK- required, array passed by reference
118 ; array of remittance remarks
119 ; format
120 ; FBRRMK(#)=FBRRMKC
121 ; where
122 ; # = integer number greater than 0
123 ; FBRRMKC = remittance remark (internal value file 162.93)
124 ; Result
125 ; string containing sorted list (by external code) of remarks
126 ; format
127 ; FBRRMKCE 1, FBRRMKCE 2
128 ; where
129 ; FBRRMKCE = remittance remark code (external value)
130 N FBRET
131 N FBRRMKC,FBRRMKCE
132 N FBRRMKS,FBI
133 S FBRET=""
134 ;
135 ; build sorted array containing external values
136 S FBI=0 F S FBI=$O(FBRRMK(FBI)) Q:'FBI D
137 . ; obtain internal values
138 . S FBRRMKC=$P(FBRRMK(FBI),U)
139 . ; convert to external values
140 . S FBRRMKCE=$S(FBRRMKC:$P($G(^FB(161.93,FBRRMKC,0)),U),1:"")
141 . ; store in sorted array
142 . S FBRRMKS(FBRRMKCE_U_FBI)=FBRRMKCE_","
143 ;
144 ; build list from sorted array
145 S FBI="" F S FBI=$O(FBRRMKS(FBI)) Q:FBI="" D
146 . S FBRET=FBRET_FBRRMKS(FBI)
147 ; strip trailing "," from list
148 I $E(FBRET,$L(FBRET))="," S FBRET=$E(FBRET,1,$L(FBRET)-1)
149 ;
150 Q FBRET
151 ;
152 ;FBUTL4
Note: See TracBrowser for help on using the repository browser.