FBNHEP1.m

FBNHEP1 ;AISC/GRR-PAYMENT PROCESS CONTINUED ;7/8/2003

 ;;3.5;FEE BASIS;**12,61,158**;JAN 30, 1995;Build 94

 ;;Per VA Directive 6402, this routine should not be modified.

 N FBADJ,FBRRMK,FBX,FBFPPSC,FBFPPSL

 K FBAAID,FBAAVID D GETNXI^FBAAUTL W !!,"Invoice # ",FBAAIN," assigned to this invoice"

 S DIC="^FBAAI(",X=FBAAIN,DIC(0)="L",DLAYGO=162.5 D ^DIC S DA=+Y K DLAYGO

RID D GETINDT^FBAACO1 G DEL:$G(FBAAOUT)

 S DIE=DIC,FBNL=""

 S FBI7078=FB7078_";FB7078("

 S DR="1////^S X=FBAAID;46////^S X=FBAAVID;47////^S X=1;2////^S X=IFN;3////^S X=DFN;20////^S X=FBBAT;55"

 S DR(1,162.5,1)="S FBFPPSC=$$FPPSC^FBUTL5();S:FBFPPSC=-1 Y=0;S:FBFPPSC="""" Y=""@20"";56///^S X=FBFPPSC;S FBFPPSL=$$FPPSL^FBUTL5(,1);S:FBFPPSL=-1 Y=0;57///^S X=FBFPPSL;@20;54//^S X=$G(FBTRDYS)"

 S DR(1,162.5,2)="7;S FBNHAC=X;5////^S X=$S(FBPAYDT>FBAABDT:(FBPAYDT+1),1:FBAABDT);6////^S X=FBENDDT;8//^S X=$S(FBNHAC>FBDEFP:FBDEFP,1:FBNHAC);S FBAMTP=X"

 S DR(1,162.5,3)="S FBX=$$ADJ^FBUTL2(FBNHAC-FBAMTP,.FBADJ,1,,,,.FBRRMK,1);S:FBX=0 Y=0"

 S DR(1,162.5,4)="11////^S X=7;12////^S X=FBAAPTC;23////^S X=FBPSA;4////^S X=FBI7078;21////^S X=FBPOV;22////^S X=FBPT;S FBTST=1"

 D ^DIE I '$G(FBTST) W !,*7,"Entering an '^' will delete this payment" S DIR(0)="Y",DIR("A")="Shall I delete",DIR("B")="No" D ^DIR G DEL:$D(DIRUT)!(Y),RID

 ; file adjustment reasons

 D FILEADJ^FBCHFA(DA_",",.FBADJ)

 ; file remittance remarks

 D FILERR^FBCHFR(DA_",",.FBRRMK)

 K FBTST G GETVET^FBNHEP

DEL S DIK="^FBAAI(" W !!,"Deleting Invoice !" D ^DIK K DIK G GETVET^FBNHEP

 Q

PROB W !,*7,"The patient was not in this vendor's facility for the month and year selected!",!,"Use the Display Episode of Care option to review this veteran's activity!" S FBERR=1

 Q

 ;

TRUB W !!,*7,"Check Contract data for Community Nursing Home: ",$P(^FBAAV(IFN,0),"^",1),!,"It is not complete",!! S FBERR=1 Q

 ;

DAYS(X) ;CALCULATES THE NUMBER OF DAYS IN MONTH

 N X1

 S X1=X,X=+$E(X,4,5),X=$S("^1^3^5^7^8^10^12^"[("^"_X_"^"):31,X=2:28,1:30)

 I X=28 D

 . N YEAR

 . S YEAR=$E(X1,1,3)+1700

 . I $S(YEAR#400=0:1,YEAR#4=0&'(YEAR#100=0):1,1:0) S X=29

 Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBNHEP1   2093     printed  Apr 09, 2024@21:02:48                                                                                                                                                                                                     Page 2

FBNHEP1   ;AISC/GRR-PAYMENT PROCESS CONTINUED ;7/8/2003

 +1       ;;3.5;FEE BASIS;**12,61,158**;JAN 30, 1995;Build 94

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3        NEW FBADJ,FBRRMK,FBX,FBFPPSC,FBFPPSL

 +4        KILL FBAAID,FBAAVID

           DO GETNXI^FBAAUTL

           WRITE !!,"Invoice # ",FBAAIN," assigned to this invoice"

 +5        SET DIC="^FBAAI("

           SET X=FBAAIN

           SET DIC(0)="L"

           SET DLAYGO=162.5

           DO ^DIC

           SET DA=+Y

           KILL DLAYGO

RID        DO GETINDT^FBAACO1

           if $GET(FBAAOUT)

               GOTO DEL

 +1        SET DIE=DIC

           SET FBNL=""

 +2        SET FBI7078=FB7078_";FB7078("

 +3        SET DR="1////^S X=FBAAID;46////^S X=FBAAVID;47////^S X=1;2////^S X=IFN;3////^S X=DFN;20////^S X=FBBAT;55"

 +4        SET DR(1,162.5,1)="S FBFPPSC=$$FPPSC^FBUTL5();S:FBFPPSC=-1 Y=0;S:FBFPPSC="""" Y=""@20"";56///^S X=FBFPPSC;S FBFPPSL=$$FPPSL^FBUTL5(,1);S:FBFPPSL=-1 Y=0;57///^S X=FBFPPSL;@20;54//^S X=$G(FBTRDYS)"

 +5        SET DR(1,162.5,2)="7;S FBNHAC=X;5////^S X=$S(FBPAYDT>FBAABDT:(FBPAYDT+1),1:FBAABDT);6////^S X=FBENDDT;8//^S X=$S(FBNHAC>FBDEFP:FBDEFP,1:FBNHAC);S FBAMTP=X"

 +6        SET DR(1,162.5,3)="S FBX=$$ADJ^FBUTL2(FBNHAC-FBAMTP,.FBADJ,1,,,,.FBRRMK,1);S:FBX=0 Y=0"

 +7        SET DR(1,162.5,4)="11////^S X=7;12////^S X=FBAAPTC;23////^S X=FBPSA;4////^S X=FBI7078;21////^S X=FBPOV;22////^S X=FBPT;S FBTST=1"

 +8        DO ^DIE

           IF '$GET(FBTST)

               WRITE !,*7,"Entering an '^' will delete this payment"

               SET DIR(0)="Y"

               SET DIR("A")="Shall I delete"

               SET DIR("B")="No"

               DO ^DIR

               if $DATA(DIRUT)!(Y)

                   GOTO DEL

               GOTO RID

 +9       ; file adjustment reasons

 +10       DO FILEADJ^FBCHFA(DA_",",.FBADJ)

 +11      ; file remittance remarks

 +12       DO FILERR^FBCHFR(DA_",",.FBRRMK)

 +13       KILL FBTST

           GOTO GETVET^FBNHEP

DEL        SET DIK="^FBAAI("

           WRITE !!,"Deleting Invoice !"

           DO ^DIK

           KILL DIK

           GOTO GETVET^FBNHEP

 +1        QUIT 

PROB       WRITE !,*7,"The patient was not in this vendor's facility for the month and year selected!",!,"Use the Display Episode of Care option to review this veteran's activity!"

           SET FBERR=1

 +1        QUIT 

 +2       ;

TRUB       WRITE !!,*7,"Check Contract data for Community Nursing Home: ",$PIECE(^FBAAV(IFN,0),"^",1),!,"It is not complete",!!

           SET FBERR=1

           QUIT 

 +1       ;

DAYS(X)   ;CALCULATES THE NUMBER OF DAYS IN MONTH

 +1        NEW X1

 +2        SET X1=X

           SET X=+$EXTRACT(X,4,5)

           SET X=$SELECT("^1^3^5^7^8^10^12^"[("^"_X_"^"):31,X=2:28,1:30)

 +3        IF X=28

               Begin DoDot:1

 +4                NEW YEAR

 +5                SET YEAR=$EXTRACT(X1,1,3)+1700

 +6                IF $SELECT(YEAR#400=0:1,YEAR#4=0&'(YEAR#100=0):1,1:0)

                       SET X=29

               End DoDot:1

 +7        QUIT X