source: FOIAVistA/tag/r/FEE_BASIS-FB/FBRXFA.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1FBRXFA ;WOIFO/SAB-FILE ADJUSTMENTS FOR PHARMACY PAYMENT ;9/9/2003
2 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
3 Q
4FILEADJ(FBIENS,FBADJ) ; File Adjustments
5 ;
6 ; Input
7 ; FBIENS - required, internal entry numbers for subfile 162.11
8 ; in standard format as specified for FileMan DBS calls
9 ; FBADJ - required, array passed by reference
10 ; array of adjustments to file
11 ; array does not have to contain any data or be defined
12 ; format
13 ; FBADJ(#)=FBADJR^FBADJG^FBADJA
14 ; where
15 ; # = sequentially assigned number starting with 1
16 ; FBADJR = adjustment reason (internal value file 162.91)
17 ; FBADJG = adjustment group (internal value file 162.92)
18 ; FBADJA = adjustment amount (dollar value)
19 ; Output
20 ; Data in File 162.11 will be modified
21 ;
22 N FB,FBFDA,FBHIGH,FBI,FBMSR,FBSC,FBSIENS,FBTAS
23 ;
24 ; delete adjustment reasons currently on file
25 D GETS^DIQ(162.11,FBIENS,"37*","","FB")
26 K FBFDA
27 S FBSIENS="" F S FBSIENS=$O(FB(162.14,FBSIENS)) Q:FBSIENS="" D
28 . S FBFDA(162.14,FBSIENS,.01)="@"
29 I $D(FBFDA) D FILE^DIE("","FBFDA")
30 ;
31 ; delete suspend data currently on file
32 K FBFDA
33 S FBFDA(162.11,FBIENS,6)="@"
34 S FBFDA(162.11,FBIENS,7)="@"
35 I $D(FBFDA) D FILE^DIE("","FBFDA")
36 ;
37 ; delete suspension description currently on file
38 D WP^DIE(162.11,FBIENS,20,,"@")
39 ;
40 ; compute total amount suspended and determine most significant reason
41 ; loop thru reasons
42 S (FBTAS,FBI,FBHIGH)=0,FBMSR=""
43 F S FBI=$O(FBADJ(FBI)) Q:'FBI D
44 . N FBADJA
45 . ; get adjustment amount for reason
46 . S FBADJA=$P(FBADJ(FBI),U,3)
47 . ; add amount to total
48 . S FBTAS=FBTAS+FBADJA
49 . ; check if reason has largest absolute $ impact
50 . I $FN(FBADJA,"-")>$G(FBHIGH) S FBMSR=FBI,FBHIGH=$FN(FBADJA,"-")
51 ;
52 I +FBTAS=0 Q ; quit since total amount suspended is 0
53 ;
54 ; file adjustments from input array
55 K FBFDA
56 S FBI=0 F S FBI=$O(FBADJ(FBI)) Q:'FBI D
57 . S FBFDA(162.14,"+"_FBI_","_FBIENS,.01)=$P(FBADJ(FBI),U)
58 . S FBFDA(162.14,"+"_FBI_","_FBIENS,1)=$P(FBADJ(FBI),U,2)
59 . S FBFDA(162.14,"+"_FBI_","_FBIENS,2)=+$P(FBADJ(FBI),U,3)
60 I $D(FBFDA) D UPDATE^DIE("","FBFDA")
61 ;
62 ; file derived suspend data
63 K FBFDA
64 S FBFDA(162.11,FBIENS,6)=FBTAS
65 I FBMSR,$P(FBADJ(FBMSR),U) S FBSC=$$GET1^DIQ(161.91,$P(FBADJ(FBMSR),U),3)
66 I '$G(FBSC) S FBSC=4
67 S FBFDA(162.11,FBIENS,7)=FBSC
68 I $D(FBFDA) D FILE^DIE("","FBFDA")
69 ;
70 ; if suspend code = 4 (other) then file suspension description
71 I FBSC=4,FBMSR,$P(FBADJ(FBMSR),U) D WP^DIE(162.11,FBIENS,20,,"^FB(161.91,"_$P(FBADJ(FBMSR),U)_",4)")
72 D MSG^DIALOG()
73 ;
74 Q
75 ;
76LOADADJ(FBIENS,FBADJ) ; Load Adjustments
77 ; Input
78 ; FBIENS - required, internal entry numbers for subfile 162.11
79 ; in standard format as specified for FileMan DBS calls
80 ; FBADJ - required, array passed by reference
81 ; array to load adjustments into
82 ; Output
83 ; FBADJ - the FBADJ input array passed by reference will be modified
84 ; format
85 ; FBADJ(#)=FBADJR^FBADJG^FBADJA
86 ; where
87 ; # = sequentially assigned number starting with 1
88 ; FBADJR = adjustment reason (internal value file 162.91)
89 ; FBADJG = adjustment group (internal value file 162.92)
90 ; FBADJA = adjustment amount (dollar value)
91 ; if no adjustments are on file then the array will be
92 ; undefined
93 N FB,FBC,FBI,FBSIENS
94 ;
95 K FBADJ
96 ;
97 S FBC=0
98 D GETS^DIQ(162.11,FBIENS,"37*","I","FB")
99 D MSG^DIALOG()
100 S FBSIENS="" F S FBSIENS=$O(FB(162.14,FBSIENS)) Q:FBSIENS="" D
101 . S FBC=FBC+1
102 . S FBADJ(FBC)=FB(162.14,FBSIENS,.01,"I")
103 . S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,1,"I")
104 . S FBADJ(FBC)=FBADJ(FBC)_U_FB(162.14,FBSIENS,2,"I")
105 ;
106 Q
107 ;
108ADJLRA(FBIENS) ; Adjustment Reason^Amount List Extrinsic Function
109 ; Input
110 ; FBIENS - required, internal entry numbers for subfile 162.11
111 ; in standard format as specified for FileMan DBS calls
112 ; Result
113 ; string containing sorted list (by external code) of reason^amounts
114 ; format
115 ; FBADJE 1, FBADJE 2^FBADJA 1,FBADJA2
116 ; where
117 ; FBADJE = adjustment reason code (external value)
118 ; FBADJA = adjustment amount
119 N FBRET,FBADJ,FBADJL,FBADJLA,FBADJLR
120 D LOADADJ^FBRXFA(FBIENS,.FBADJ)
121 S FBADJL=$$ADJL^FBUTL2(.FBADJ)
122 S FBADJLR=$$ADJLR^FBUTL2(FBADJL)
123 S FBADJLA=$$ADJLA^FBUTL2(FBADJL)
124 S FBRET=FBADJLR_U_FBADJLA
125 Q FBRET
126 ;
127 ;FBRXFA
Note: See TracBrowser for help on using the repository browser.