FBUCUTL8 ;ALBISC/TET - UTILITY (continued) ;10/10/2001
;;3.5;FEE BASIS;**38**;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
EXPIRE(FBDA,FBDT,FBUCA,FBORDER) ;determine expiration date based upon status order
;INPUT: FBDA - internal entry number of unauthorized claim, 162.7
; FBDT - date used to which expiration days are added,
; value is either date letter sent, or if no letter, today's date
; or date statement of the case issued, depending on status.
; FBUCA - current (or after) zero node of claim
; FBORDER - status order number
;OUTPUT: expiration date, based on days associated with status.
; no expiration date if dispostion is approved or canceled/withdrawn
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
N FBEXP,FBORIG,FBSTATUS,DAYS S FBEXP=+$P(FBUCA,U,26),FBORIG=+$P(FBUCA,U,22)
S FBSTATUS=$$STATUS^FBUCUTL(FBORDER),DAYS=$$DAYS^FBUCUTL(FBSTATUS,$P(FBUCA,U,28))
I $P(FBUCA,U,11)=3 S FBEXP=$S($P(FBUCA,U,26):"@",1:0) G EXPIREQ
I 'DAYS,+FBEXP S FBEXP="@"
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))
;if order=55, get number of days between date statement of case issued
; or date letter sent and date of original disposition;
; expiration date is either remainder of year or 60 days,
; whichever is greater.
; if incomplete Mill Bill claim then check for an extension
I FBEXP'="@",$P(FBUCA,U,28),FBORDER=10 D
. N FBED
. ; obtain most recent extension date (if any)
. S FBED=$P($$EXT(FBDA,FBORDER),U,2)
. ; use extension date if later then the computed expiration date
. I FBED]"",FBED>FBEXP S FBEXP=FBED
EXPIREQ Q $G(FBEXP)
DISAPR ;check disapproval reason and file if all same, or ask if diff from pr.
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
F I=2:1 S J=$P(FBUCDISR,U,I) Q:'J D DISAP^FBUCUTL(FBDA,J)
Q
EXT(FBDA,FBORDER) ; Obtain most recent extension for status
; input FBDA = ien of claim in file 162.7
; FBORDER = status order number
; returns string = ien of extension^extension date OR
; null if no extension
N FBDA1,FBXD,FBRET,FBSTATUS,FBY
S FBRET="" ; initalize return value
;
I '$G(FBDA)!'$G(FBORDER) Q FBRET
;
; get ien of status that extension should apply to
S FBSTATUS=$$STATUS^FBUCUTL(FBORDER)
;
; loop thru entered extensions in reverse chronological order
S FBXD=" "
F S FBXD=$O(^FB583(FBDA,3,"B",FBXD),-1) Q:'FBXD D Q:FBRET
. S FBDA1=" "
. F S FBDA1=$O(^FB583(FBDA,3,"B",FBXD,FBDA1),-1) Q:'FBDA1 D Q:FBRET
. . S FBY=$G(^FB583(FBDA,3,FBDA1,0))
. . Q:$P(FBY,U,3)'=FBSTATUS ; ignore extensions for a different status
. . Q:$P(FBY,U,4)="" ; extension date was not entered
. . S FBRET=FBDA1_U_$P(FBY,U,4)
;
Q FBRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCUTL8 3115 printed Dec 13, 2024@02:00:37 Page 2
FBUCUTL8 ;ALBISC/TET - UTILITY (continued) ;10/10/2001
+1 ;;3.5;FEE BASIS;**38**;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
EXPIRE(FBDA,FBDT,FBUCA,FBORDER) ;determine expiration date based upon status order
+1 ;INPUT: FBDA - internal entry number of unauthorized claim, 162.7
+2 ; FBDT - date used to which expiration days are added,
+3 ; value is either date letter sent, or if no letter, today's date
+4 ; or date statement of the case issued, depending on status.
+5 ; FBUCA - current (or after) zero node of claim
+6 ; FBORDER - status order number
+7 ;OUTPUT: expiration date, based on days associated with status.
+8 ; no expiration date if dispostion is approved or canceled/withdrawn
+9 NEW FBEXP
IF $SELECT('FBDA:1,'$DATA(FBDT):1,'FBDT:1,'$DATA(FBUCA):1,'$DATA(FBORDER):1,'FBORDER:1,1:0)
SET FBEXP=0
GOTO EXPIREQ
+10 NEW FBEXP,FBORIG,FBSTATUS,DAYS
SET FBEXP=+$PIECE(FBUCA,U,26)
SET FBORIG=+$PIECE(FBUCA,U,22)
+11 SET FBSTATUS=$$STATUS^FBUCUTL(FBORDER)
SET DAYS=$$DAYS^FBUCUTL(FBSTATUS,$PIECE(FBUCA,U,28))
+12 IF $PIECE(FBUCA,U,11)=3
SET FBEXP=$SELECT($PIECE(FBUCA,U,26):"@",1:0)
GOTO EXPIREQ
+13 IF 'DAYS
IF +FBEXP
SET FBEXP="@"
+14 IF DAYS
IF FBEXP'="@"
if FBORDER'=55
SET FBEXP=$$CDTC^FBUCUTL(FBDT,DAYS)
IF FBORDER=55
SET DAYS=DAYS-$$DTC^FBUCUTL(FBDT,FBORIG)
SET FBEXP=$$CDTC^FBUCUTL(FBDT,$SELECT(DAYS'>60:60,1:DAYS))
+15 ;if order=55, get number of days between date statement of case issued
+16 ; or date letter sent and date of original disposition;
+17 ; expiration date is either remainder of year or 60 days,
+18 ; whichever is greater.
+19 ; if incomplete Mill Bill claim then check for an extension
+20 IF FBEXP'="@"
IF $PIECE(FBUCA,U,28)
IF FBORDER=10
Begin DoDot:1
+21 NEW FBED
+22 ; obtain most recent extension date (if any)
+23 SET FBED=$PIECE($$EXT(FBDA,FBORDER),U,2)
+24 ; use extension date if later then the computed expiration date
+25 IF FBED]""
IF FBED>FBEXP
SET FBEXP=FBED
End DoDot:1
EXPIREQ QUIT $GET(FBEXP)
DISAPR ;check disapproval reason and file if all same, or ask if diff from pr.
+1 IF FBUCDISR=0
WRITE !?3,"No: ",FBDA,?15,"Treatment From: ",$$DATX^FBAAUTL($PIECE(FBUCA,U,5))
if $PIECE(FBUCA,U,6)
WRITE ?40,"Treatment To: ",$$DATX^FBAAUTL($PIECE(FBUCA,U,6))
SET DIE="^FB583("
SET DA=FBDA
SET DR=15
DO ^DIE
KILL DIE,DA,DR
QUIT
+2 FOR I=2:1
SET J=$PIECE(FBUCDISR,U,I)
if 'J
QUIT
DO DISAP^FBUCUTL(FBDA,J)
+3 QUIT
EXT(FBDA,FBORDER) ; Obtain most recent extension for status
+1 ; input FBDA = ien of claim in file 162.7
+2 ; FBORDER = status order number
+3 ; returns string = ien of extension^extension date OR
+4 ; null if no extension
+5 NEW FBDA1,FBXD,FBRET,FBSTATUS,FBY
+6 ; initalize return value
SET FBRET=""
+7 ;
+8 IF '$GET(FBDA)!'$GET(FBORDER)
QUIT FBRET
+9 ;
+10 ; get ien of status that extension should apply to
+11 SET FBSTATUS=$$STATUS^FBUCUTL(FBORDER)
+12 ;
+13 ; loop thru entered extensions in reverse chronological order
+14 SET FBXD=" "
+15 FOR
SET FBXD=$ORDER(^FB583(FBDA,3,"B",FBXD),-1)
if 'FBXD
QUIT
Begin DoDot:1
+16 SET FBDA1=" "
+17 FOR
SET FBDA1=$ORDER(^FB583(FBDA,3,"B",FBXD,FBDA1),-1)
if 'FBDA1
QUIT
Begin DoDot:2
+18 SET FBY=$GET(^FB583(FBDA,3,FBDA1,0))
+19 ; ignore extensions for a different status
if $PIECE(FBY,U,3)'=FBSTATUS
QUIT
+20 ; extension date was not entered
if $PIECE(FBY,U,4)=""
QUIT
+21 SET FBRET=FBDA1_U_$PIECE(FBY,U,4)
End DoDot:2
if FBRET
QUIT
End DoDot:1
if FBRET
QUIT
+22 ;
+23 QUIT FBRET
