- 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 ---[H[J[2J[HFBNHEP1 2093 printed Feb 18, 2025@23:25:27 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