source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCUTL.m@ 861

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

initial load of WorldVistAEHR
File size: 6.7 KB
Line 
1FBUCUTL ;ALBISC/TET - UNAUTHORIZED CLAIMS UTILITY ;12/7/2001
2 ;;3.5;FEE BASIS;**38**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4CDTC(X1,X2) ;date comparison
5 ;INPUT: X1 = date
6 ; X2 = days to subtract or add
7 ;OUTPUT: date less/plus x days
8 N X D C^%DTC K %H Q $G(X)
9 ;
10DTC(X1,X2) ;days between two days
11 ;INPUT: X1 = date one
12 ; X2 = date two
13 ;OUTPUT: difference between two days
14 N X,%Y D ^%DTC K %Y Q $G(X)
15 ;
16VET(X) ;veteran name
17 ;INPUT: internal entry number of veteran
18 ;OUTPUT: veteran name or unknown
19 S X=$G(^DPT(+X,0)) Q $S($P(X,U)]"":$P(X,U),1:"UNKNOWN")
20 ;
21VEN(X) ;vendor name
22 ;INPUT: internal entry number of vendor
23 ;OUTPUT: vendor name or unknown
24 S X=$G(^FBAAV(+X,0)) Q $S($P(X,U)]"":$P(X,U),1:"UNKNOWN")
25 ;
26PROG(X) ;fee program name
27 ;INPUT: internal entry number of fee program
28 ;OUTPUT: fee program name or unknown
29 S X=$G(^FBAA(161.8,+X,0)) Q $S($P(X,U)]"":$P(X,U),1:"UNKNOWN")
30 ;
31PTR(FBGL,FBIEN) ;get .01 value of pointer
32 ;INPUT: FBGL = global root
33 ; FBIEN = internal entry number (DA) of pointed to file
34 ;OUTPUT: zero node, or 'UNKNOWN'
35 N FBVAL,NODE S NODE=FBGL_+FBIEN_",0)"
36 S FBVAL=$G(@(NODE))
37 Q $S(FBVAL]"":FBVAL,1:"UNKNOWN")
38 ;
39LOCK(FBGL,FBDA,GO) ;lock entry before editing
40 ;INPUT: FBGL = global root
41 ; FBDA = interal entry number of file
42 ; GO = 1 to continue to try (enter/updates),
43 ; 0 to notify user and quit on failure (edits)
44 ; (optional, if not set will be set to 0)
45 ;OUTPUT: FBLOCK = 1 if successful; 0 if failed
46 ; incremental lock may be issued
47 S FBLOCK=0,GO=$S('$D(GO):0,1:+GO) I $S('$D(FBGL):1,FBGL']"":1,'$D(FBDA):1,'+FBDA:1,1:0) Q
48 S FBGL=FBGL_FBDA_")"
49L L +@FBGL:2 S FBLOCK=$T I 'FBLOCK G:GO L W:'GO&('$D(ZTQUEUED)) !,"Another user is editing this entry."
50 Q
51DAYS(X,FB1725) ;number of days associated with a status
52 ;INPUT: X=ien of status in file 162.92
53 ; FB1725=true if days for 38 U.S.C. 1725 claim should be returned
54 ;OUTPUT: 0 or number of days
55 N FBY
56 S FBY=$G(^FB(162.92,X,0))
57 Q $S($G(FB1725):+$P(FBY,U,7),1:+$P(FBY,U,3))
58 ;
59DISAP(DA1,X) ;disapproval reason for disapproved dispositions
60 ;INPUT: DA1 = DA of top level of record (DA(1))
61 ; X = ien of disapproval reason, 162.94
62 ;OUTPUT: none - entry to disapproval multiple if not already there, disapproval reason is active and disposition reason is other than approved.
63 N Y,DA,DIC
64 S DIC(0)="Z",DIC="^FB583("_DA1_",""D"","
65 I $P(^FB583(DA1,0),U,11)>1,$P(^FB(162.94,+X,0),U,2),'$D(^FB583(DA1,"D","B",+X)) S:'$D(^FB583(DA1,"D")) ^FB583(DA1,"D",0)="^162.715PA^^" S DA(1)=DA1 K DD,DO D FILE^DICN
66 Q
67STATUS(X) ;get status internal entry number
68 ;INPUT: X = order number of status in file 162.92
69 ;OUTPUT: ien of status in file 162.92 (status file)
70 Q +$O(^FB(162.92,"AO",X,0))
71 ;
72ORDER(X) ;get order number of status
73 ;INPUT: X = ien of status in file 162.92, status file
74 ;OUTPUT: order number of status
75 S X=$G(^FB(162.92,+X,0)) Q +$P(X,U,4)
76 ;
77PAY(X,FBGL) ;determine if any payments have been made
78 ;INPUT: X= ien in file
79 ; FBGL= global root
80 ;OUTPUT: 0 if no payments, 1 if payments
81 S:$E(FBGL,1)="^" FBGL=$P(FBGL,"^",2) S FBGL=X_";"_FBGL
82 Q $S(+$O(^FBAA(162.1,"AO",FBGL,0)):1,+$O(^FBAAC("AM",FBGL,0)):1,+$O(^FBAAI("E",FBGL,0)):1,1:0)
83 ;
84OVER(KEY) ;determine if ability to override
85 ;INPUT: KEY=security key
86 ;OUTPUT: 0 if not holder of key, 1 if holder of key
87 Q $S($D(^XUSEC(KEY,DUZ)):1,1:0)
88 ;
89UPOK(X) ;ok to update
90 ;INPUT: X= ien of 162.7
91 ;OUTPUT: 0 if NOT OK to update, 1 if OK to update
92 Q $S('$$PAY(X,"^FB583("):1,$$OVER("FBAASUPERVISOR"):1,1:0)
93 ;
94TIME(ED) ;determine if expiration date passed
95 ;INPUT: ED= expiration date
96 ;OUTPUT: 0 if late, 1 if within timeframe
97 Q $S('ED:1,DT>ED:0,1:1)
98UNTIME(FBX) ;write untimely message - called from input templates
99 ;INPUT: FBX = disapproval reason
100 W !?5,"Claim has been dispositioned to DISAPPROVED" W:+FBX !?8,"with disapproval reason of '",$P($$PTR("^FB(162.94,",FBX),U),"'.",!,*7
101 Q
102 ;
103FBZ(X) ;get zero node on 162.7
104 ;INPUT: X = ien of 162.7, unauthorized claim file
105 ;OUTPUT: zero node of 162.7
106 I '+X Q 0
107 S X=+X Q $G(^FB583(X,0))
108 ;
109FILE(FBGL,X,FBDI,FBDA1) ;add entry to file or subfile
110 ;INPUT: FBGL = global root
111 ; X = value for .01 field
112 ; FBDI = 1 for dinum entry, 0 or null if not (optional)
113 ; FBDA1 = DA(1) value (optional), if doesn't exist will not set
114 ;OUTPUT: entry is added to designated file
115 ; Y is returned ien^value of .01 field^1
116 N DA,DIC,DINUM,Y I $S(X']"":1,'$D(FBDI):1,+FBDI&(X'=+X):1,'$D(FBDA):1,1:0) Q ""
117 I $D(FBDA1) S DA(1)=FBDA1
118ADD S:+FBDI DINUM=X S DIC(0)="MZ",DIC=FBGL K DD,DO D FILE^DICN G:+Y'>0 ADD K DIC,DINUM
119 Q $G(Y)
120 ;
121PEND(FBDA) ;check if any info pending for claim
122 ;INPUT: FBDA = ien of unauthorized claim in 162.7
123 ;OUTPUT: 1 if info pending, otherwise 0
124 Q $S(+$O(^FBAA(162.8,"ACD",FBDA,0)):1,1:0)
125PAYST(FBDA,FBUCP) ; unauthorized claim payment status (released+)
126 ;INPUT: FBDA = ien of unauthorized claim in 162.7
127 ; FBUCP = name of array (optional)
128 ;RESULT: 1 (true) if at least one payment and all have been released
129 ; 0 (false) if no payments or if some have not been released
130 ;OUTPUT: if FBCUP contains the name of an array then that array will
131 ; be populated with payment information in the following format
132 ; array (claim ien) = result ^ number of payments
133 ; array (claim ien, payment file #, payment iens) = batch status
134 N FBGL,FBRET,FBPDA,FBPDA1,FBPDA2,FBPDA3,FBBS,FBC
135 S FBRET=1
136 S FBC=0
137 I $G(FBUCP)]"" K FBCUP(FBDA)
138 S FBGL=FBDA_";FB583("
139 ; pharmacy payments
140 S FBPDA=0
141 F S FBPDA=$O(^FBAA(162.1,"AO",FBGL,FBPDA)) Q:'FBPDA D
142 .S FBPDA1=0
143 .F S FBPDA1=$O(^FBAA(162.1,"AO",FBGL,FBPDA,FBPDA1)) Q:'FBPDA1 D
144 ..S FBIENS=FBPDA1_","_FBPDA_","
145 ..S FBBS=$$GET1^DIQ(162.11,FBIENS,"13:11","I")
146 ..I $G(FBUCP)]"" S @FBUCP@(FBDA,162.11,FBIENS)=FBBS
147 ..I "^S^T^V^R^"'[(U_FBBS_U) S FBRET=0
148 ..S FBC=FBC+1
149 ; outpatient and ancillary payments
150 S FBPDA=0
151 F S FBPDA=$O(^FBAAC("AM",FBGL,FBPDA)) Q:'FBPDA D
152 .S FBPDA1=0
153 .F S FBPDA1=$O(^FBAAC("AM",FBGL,FBPDA,FBPDA1)) Q:'FBPDA1 D
154 ..S FBPDA2=0
155 ..F S FBPDA2=$O(^FBAAC("AM",FBGL,FBPDA,FBPDA1,FBPDA2)) Q:'FBPDA2 D
156 ...S FBPDA3=0
157 ...F S FBPDA3=$O(^FBAAC("AM",FBGL,FBPDA,FBPDA1,FBPDA2,FBPDA3)) Q:'FBPDA3 D
158 ....S FBIENS=FBPDA3_","_FBPDA2_","_FBPDA1_","_FBPDA_","
159 ....S FBBS=$$GET1^DIQ(162.03,FBIENS,"7:11","I")
160 ....I $G(FBUCP)]"" S @FBUCP@(FBDA,162.03,FBIENS)=FBBS
161 ....I "^S^T^V^R^"'[(U_FBBS_U) S FBRET=0
162 ....S FBC=FBC+1
163 ; civil hospital payments
164 S FBPDA=0
165 F S FBPDA=$O(^FBAAI("E",FBGL,FBPDA)) Q:'FBPDA D
166 .S FBIENS=FBPDA_","
167 .S FBBS=$$GET1^DIQ(162.5,FBIENS,"20:11","I")
168 .I $G(FBUCP)]"" S @FBUCP@(FBDA,162.5,FBIENS)=FBBS
169 .I "^S^T^V^R^"'[(U_FBBS_U) S FBRET=0
170 .S FBC=FBC+1
171 I FBC=0 S FBRET=0
172 I $G(FBUCP)]"" S @FBUCP@(FBDA)=FBRET_U_FBC
173 Q FBRET
Note: See TracBrowser for help on using the repository browser.