| 1 | FBUCUTL8 ;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.
|
|---|
| 4 | EXPIRE(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
|
|---|
| 30 | EXPIREQ Q $G(FBEXP)
|
|---|
| 31 | DISAPR ;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
|
|---|
| 35 | EXT(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
|
|---|
