source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCUTL8.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1FBUCUTL8 ;ALBISC/TET - UTILITY (continued) ;10/10/2001
2 ;;3.5;FEE BASIS;**38**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EXPIRE(FBDA,FBDT,FBUCA,FBORDER) ;determine expiration date based upon status order
5 ;INPUT: FBDA - internal entry number of unauthorized claim, 162.7
6 ; FBDT - date used to which expiration days are added,
7 ; value is either date letter sent, or if no letter, today's date
8 ; or date statement of the case issued, depending on status.
9 ; FBUCA - current (or after) zero node of claim
10 ; FBORDER - status order number
11 ;OUTPUT: expiration date, based on days associated with status.
12 ; no expiration date if dispostion is approved or canceled/withdrawn
13 N FBEXP I $S('FBDA:1,'$D(FBDT):1,'FBDT:1,'$D(FBUCA):1,'$D(FBORDER):1,'FBORDER:1,1:0) S FBEXP=0 G EXPIREQ
14 N FBEXP,FBORIG,FBSTATUS,DAYS S FBEXP=+$P(FBUCA,U,26),FBORIG=+$P(FBUCA,U,22)
15 S FBSTATUS=$$STATUS^FBUCUTL(FBORDER),DAYS=$$DAYS^FBUCUTL(FBSTATUS,$P(FBUCA,U,28))
16 I $P(FBUCA,U,11)=3 S FBEXP=$S($P(FBUCA,U,26):"@",1:0) G EXPIREQ
17 I 'DAYS,+FBEXP S FBEXP="@"
18 I DAYS,FBEXP'="@" S:FBORDER'=55 FBEXP=$$CDTC^FBUCUTL(FBDT,DAYS) I FBORDER=55 S DAYS=DAYS-$$DTC^FBUCUTL(FBDT,FBORIG) S FBEXP=$$CDTC^FBUCUTL(FBDT,$S(DAYS'>60:60,1:DAYS))
19 ;if order=55, get number of days between date statement of case issued
20 ; or date letter sent and date of original disposition;
21 ; expiration date is either remainder of year or 60 days,
22 ; whichever is greater.
23 ; if incomplete Mill Bill claim then check for an extension
24 I FBEXP'="@",$P(FBUCA,U,28),FBORDER=10 D
25 . N FBED
26 . ; obtain most recent extension date (if any)
27 . S FBED=$P($$EXT(FBDA,FBORDER),U,2)
28 . ; use extension date if later then the computed expiration date
29 . I FBED]"",FBED>FBEXP S FBEXP=FBED
30EXPIREQ Q $G(FBEXP)
31DISAPR ;check disapproval reason and file if all same, or ask if diff from pr.
32 I FBUCDISR=0 W !?3,"No: ",FBDA,?15,"Treatment From: ",$$DATX^FBAAUTL($P(FBUCA,U,5)) W:$P(FBUCA,U,6) ?40,"Treatment To: ",$$DATX^FBAAUTL($P(FBUCA,U,6)) S DIE="^FB583(",DA=FBDA,DR=15 D ^DIE K DIE,DA,DR Q
33 F I=2:1 S J=$P(FBUCDISR,U,I) Q:'J D DISAP^FBUCUTL(FBDA,J)
34 Q
35EXT(FBDA,FBORDER) ; Obtain most recent extension for status
36 ; input FBDA = ien of claim in file 162.7
37 ; FBORDER = status order number
38 ; returns string = ien of extension^extension date OR
39 ; null if no extension
40 N FBDA1,FBXD,FBRET,FBSTATUS,FBY
41 S FBRET="" ; initalize return value
42 ;
43 I '$G(FBDA)!'$G(FBORDER) Q FBRET
44 ;
45 ; get ien of status that extension should apply to
46 S FBSTATUS=$$STATUS^FBUCUTL(FBORDER)
47 ;
48 ; loop thru entered extensions in reverse chronological order
49 S FBXD=" "
50 F S FBXD=$O(^FB583(FBDA,3,"B",FBXD),-1) Q:'FBXD D Q:FBRET
51 . S FBDA1=" "
52 . F S FBDA1=$O(^FB583(FBDA,3,"B",FBXD,FBDA1),-1) Q:'FBDA1 D Q:FBRET
53 . . S FBY=$G(^FB583(FBDA,3,FBDA1,0))
54 . . Q:$P(FBY,U,3)'=FBSTATUS ; ignore extensions for a different status
55 . . Q:$P(FBY,U,4)="" ; extension date was not entered
56 . . S FBRET=FBDA1_U_$P(FBY,U,4)
57 ;
58 Q FBRET
Note: See TracBrowser for help on using the repository browser.