source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAFA.m@ 792

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

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