FBUCUTL8.m

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 ---FBUCUTL8   3115     printed  Feb 18, 2025@23:27:02                                                                                                                                                                                                    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