1 | FBUTL5 ;WOIFO/SAB-FEE BASIS UTILITY ;7/6/2003
|
---|
2 | ;;3.5;FEE BASIS;**61**;JAN 30, 1995
|
---|
3 | Q
|
---|
4 | FPPSC(FBEDIT,FBFPPSC) ; Prompt EDI Claim and FPPS Claim ID Extrinsic Function
|
---|
5 | ; Input
|
---|
6 | ; FBEDIT - optional, true (=1) when editing an existing item
|
---|
7 | ; FBFPPSC - optional, current value of FPPS CLAIM ID
|
---|
8 | ; only passed when editing an existing item
|
---|
9 | ; Return value (FBRET)
|
---|
10 | ; = FPPS CLAIM ID if EDI Claim
|
---|
11 | ; = null if not EDI Claim
|
---|
12 | ; = -1 if time-out or '^'
|
---|
13 | ;
|
---|
14 | N FBEDI,FBRET
|
---|
15 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
16 | S FBRET=""
|
---|
17 | ;
|
---|
18 | ASKEDI ; ask if claim is an EDI claim
|
---|
19 | S DIR(0)="Y"
|
---|
20 | S DIR("A")="Is this an EDI Claim from the FPPS system"
|
---|
21 | I $G(FBEDIT) S DIR("B")=$S($G(FBFPPSC)]"":"YES",1:"NO")
|
---|
22 | D ^DIR K DIR I $D(DIRUT) S FBRET=-1 G FPPSCX
|
---|
23 | S FBEDI=Y
|
---|
24 | ;
|
---|
25 | ASKID ; If EDI then ask claim ID
|
---|
26 | I FBEDI D I $D(DTOUT)!$D(DUOUT) S FBRET=-1 G FPPSCX
|
---|
27 | . N DA
|
---|
28 | . S DIR(0)="162.7,32"
|
---|
29 | . I $G(FBFPPSC)]"" S DIR("B")=FBFPPSC
|
---|
30 | . D ^DIR K DIR Q:$D(DIRUT)
|
---|
31 | . S FBRET=Y
|
---|
32 | ;
|
---|
33 | ; If EDI and claim ID not entered then reask
|
---|
34 | I FBEDI,FBRET="" D G ASKEDI
|
---|
35 | . W $C(7),!," The FPPS CLAIM ID must be entered for EDI claims!"
|
---|
36 | ;
|
---|
37 | FPPSCX ; FPPSC Exit
|
---|
38 | Q FBRET
|
---|
39 | ;
|
---|
40 | FPPSL(FBFPPSL,FBALL,FBNOOUT) ; Prompt FPPS Line Item Extrinsic Function
|
---|
41 | ; Input
|
---|
42 | ; FBFPPSL - optional, current value of FPPS LINE ITEM
|
---|
43 | ; only passed when editing an existing item
|
---|
44 | ; FBALL - optional, true (=1) if ALL allowed as input value,
|
---|
45 | ; default is false
|
---|
46 | ; FBNOOUT - optional, boolean value, default 0, set =1 if user
|
---|
47 | ; should not be allowed to exit using an uparrow
|
---|
48 | ; Return value (FBRET)
|
---|
49 | ; = FPPS LINE ITEM
|
---|
50 | ; = -1 if time-out or '^'
|
---|
51 | ;
|
---|
52 | N FBRET
|
---|
53 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
54 | S FBRET=""
|
---|
55 | S FBNOOUT=$G(FBNOOUT,0)
|
---|
56 | S FBALL=$G(FBALL,0)
|
---|
57 | ;
|
---|
58 | ASKLI ; ask line item
|
---|
59 | I FBALL D G:FBRET]"" FPPSLX I $D(DIRUT) S FBRET=-1 G FPPSLX
|
---|
60 | . S FBRET=""
|
---|
61 | . S DIR(0)="Y"
|
---|
62 | . S DIR("A")="Does this VistA invoice cover all line items on the FPPS Claim"
|
---|
63 | . I $G(FBFPPSL)]"" S DIR("B")=$S(FBFPPSL="ALL":"YES",1:"NO")
|
---|
64 | . D ^DIR K DIR Q:$D(DIRUT)
|
---|
65 | . I Y S FBRET="ALL"
|
---|
66 | ;
|
---|
67 | S DIR(0)="LCA^1:999:0"
|
---|
68 | S DIR("A")="FPPS LINE ITEM: "
|
---|
69 | S DIR("?")="This response must be a number or a list or range, e.g., 1,3,5 or 2-4,8."
|
---|
70 | S DIR("??")="^D LIHLP^FBUTL5"
|
---|
71 | I $G(FBFPPSL)]"",FBFPPSL'="ALL" S DIR("B")=FBFPPSL
|
---|
72 | D ^DIR K DIR
|
---|
73 | I $D(DTOUT)!$D(DUOUT) S FBRET=-1 G FPPSLX
|
---|
74 | S FBRET=Y
|
---|
75 | ;
|
---|
76 | FPPSLX ; FPPSL Exit
|
---|
77 | I FBNOOUT,FBRET=-1 D G ASKLI
|
---|
78 | . W !,"'^' NOT ALLOWED"
|
---|
79 | ; strip trailing comma if any
|
---|
80 | I $E(FBRET,$L(FBRET))="," S FBRET=$E(FBRET,1,$L(FBRET)-1)
|
---|
81 | Q FBRET
|
---|
82 | ;
|
---|
83 | LIHLP ; Line Item ?? Help
|
---|
84 | W !,"Enter the line item sequence number associated with this charge. Each"
|
---|
85 | W !,"charge on the FPPS invoice document will have a line item sequence number"
|
---|
86 | W !,"associated with it. A line item can be entered individually or a group of"
|
---|
87 | W !,"charges from multiple lines can be entered. If all line items in a group"
|
---|
88 | W !,"are in numerical sequence, you may enter the first line item sequence"
|
---|
89 | W !,"number followed by a hyphen and the last line item sequence number. If"
|
---|
90 | W !,"the grouped charges are not in sequential order, each line item must be"
|
---|
91 | W !,"entered individually, followed by a comma."
|
---|
92 | W !
|
---|
93 | Q
|
---|
94 | ASKPAN() ; Ask Patient Account Number Extrinsic Function
|
---|
95 | ; Return value (FBRET)
|
---|
96 | ; = PATIENT ACCOUNT NUMBER (if entered)
|
---|
97 | ; = null if value not entered
|
---|
98 | ; = '^' if time-out or '^'
|
---|
99 | N FBRET
|
---|
100 | N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
101 | S FBRET=""
|
---|
102 | S DIR(0)="162.03,49"
|
---|
103 | D ^DIR K DIR
|
---|
104 | I $D(DTOUT)!$D(DUOUT) S FBRET="^"
|
---|
105 | I '$D(DIRUT) S FBRET=Y
|
---|
106 | Q FBRET
|
---|
107 | ;
|
---|
108 | ASKREVC() ; Ask Revenue Code Extrinsic Function
|
---|
109 | ; Return value (FBRET)
|
---|
110 | ; = REVENUE CODE, internal pointer value (if entered)
|
---|
111 | ; = null if value not entered
|
---|
112 | ; = '^' if time-out or '^'
|
---|
113 | N FBRET
|
---|
114 | N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
115 | S FBRET=""
|
---|
116 | S DIR(0)="162.03,48"
|
---|
117 | D ^DIR K DIR
|
---|
118 | I $D(DTOUT)!$D(DUOUT) S FBRET="^"
|
---|
119 | I '$D(DIRUT) S FBRET=+Y
|
---|
120 | Q FBRET
|
---|
121 | ;
|
---|
122 | ASKUNITS() ; Ask Units Paid Extrinsic Function
|
---|
123 | ; Return value (FBRET)
|
---|
124 | ; = UNITS PAID (if entered)
|
---|
125 | ; = null if value not entered
|
---|
126 | ; = '^' if time-out or '^'
|
---|
127 | N FBRET
|
---|
128 | N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
129 | S FBRET=""
|
---|
130 | S DIR(0)="162.03,47"
|
---|
131 | S DIR("B")=1
|
---|
132 | D ^DIR K DIR
|
---|
133 | I $D(DTOUT)!$D(DUOUT) S FBRET="^"
|
---|
134 | I '$D(DIRUT) S FBRET=Y
|
---|
135 | Q FBRET
|
---|
136 | ;
|
---|
137 | ASKPCN() ; Ask Patient Control Number Extrinsic Function
|
---|
138 | ; Return value (FBRET)
|
---|
139 | ; = PATIENT ACCOUNT NUMBER (if entered)
|
---|
140 | ; = null if value not entered
|
---|
141 | ; = '^' if time-out or '^'
|
---|
142 | N FBRET
|
---|
143 | N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
---|
144 | S FBRET=""
|
---|
145 | S DIR(0)="162.5,55"
|
---|
146 | D ^DIR K DIR
|
---|
147 | I $D(DTOUT)!$D(DUOUT) S FBRET="^"
|
---|
148 | I '$D(DIRUT) S FBRET=Y
|
---|
149 | Q FBRET
|
---|
150 | ;
|
---|
151 | ;FBUTL5
|
---|