FBAADD1 ;WOIFO/SAB - REPROCESS OVERDUE BATCH ;4/19/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
; ICRs
; #2053 FILE^DIE
; #2054 CLEAN^DILF
; #10004 EN^DIQ
; #10006 ^DIC
; #10026 ^DIR
; #10103 $$DOW^XLFDT, $$FMADD^XLFDT
;
W !,"This option is used to reprocess an overdue payment batch."
W !,"A batch is considered overdue if the Payment Batch Result message"
W !,"has not been received by the 3rd weekday after the batch was"
W !,"transmitted to Central Fee."
W !
W !,"The National Service Desk Austin should be contacted to determine"
W !,"the status of the batch before using this option. If Central Fee"
W !,"already has the batch, you should request that Central Fee resend"
W !,"the Payment Batch Result message. If Central Fee does not have"
W !,"the batch then use this option to reprocess it.",!
;
N DA,DIC,DIR,DIRUT,DR,DTOUT,DUOUT,FBACT,FBDT,FBN,X,Y
;
; determine date that is 3 weekdays prior to the current date
S FBDT=$$CALCDT(3,DT)
;
BT ; select batch
S DIC="^FBAA(161.7,",DIC(0)="AEQ"
; status = TRANSMITTED and DATE TRANSMITTED not after FBDT
S DIC("S")="I ($G(^(""ST""))=""T"")&($P($G(^(0)),""^"",14)'>"_FBDT_")"
D ^DIC K DIC G END:Y<0
L +^FBAA(161.7,+Y):$G(DILOCKTM,3)
I '$T W !,"Another user is editing this batch. Try again later." G BT
S FBN=+Y
;
; display batch
S DIC="^FBAA(161.7,",DA=FBN,DR="0:1;ST" W !! D EN^DIQ
;
; confirm help desk was contacted
S DIR(0)="Y"
S DIR("A")="Have you confirmed the batch is not in Central Fee"
W !
D ^DIR K DIR G:$D(DIRUT) END
I 'Y W !,"Please contact the National Service Desk Austin to determine the batch status." G END
;
ASKACT ; ask action
S DIR(0)="S^R:RETRANSMIT BY RESETTING BATCH STATUS;F:FLAG ENTIRE BATCH AS REJECTED"
S DIR("A")="What action should be taken to reprocess this batch"
D ^DIR K DIR G:$D(DIRUT) END
S FBACT=Y
;
; confirm action
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Are you sure you want to "_$S(FBACT="R":"retransmit",1:"reject")_" this batch"
D ^DIR K DIR G:$D(DIRUT) END G:'Y ASKACT
;
; perform selected action
I FBACT="R" D ACTR
I FBACT="F" D ACTF
;
; display batch
S DIC="^FBAA(161.7,",DA=FBN,DR="0:1;ST" W !! D EN^DIQ
;
END ;
I $G(FBN) L -^FBAA(161.7,FBN)
Q
;
CALCDT(FBN,FBDT) ; Calculate Date
; input
; FBN - (optional) integer, default 3
; FBDT - (optional) date in FileMan internal format, default today
; returns date that is FBN workdays before the FBDT
N FBC,FBI,FBPDT,FBRET,FBWKDAY
S (FBDT,FBRET)=$G(FBDT,DT)
S FBN=$G(FBN,3)
S FBWKDAY="^Monday^Tuesday^Wednesday^Thursday^Friday^"
S FBC=0
I FBN>0 F FBI=-1:-1 D I FBC'<FBN S FBRET=FBPDT Q
. S FBPDT=$$FMADD^XLFDT(FBDT,FBI)
. I FBWKDAY[("^"_$$DOW^XLFDT(FBPDT)_"^") S FBC=FBC+1
Q FBRET
;
ACTR ; action R (retransmit)
N FBFDA,FBSTAT,FZ
S FZ=$G(^FBAA(161.7,FBN,0))
;
; determine status immediately prior to T (TRANSMITTED)
S FBSTAT="S" ; init as S
; change to R for civil hospital batch that is not pricer exempt
I $P(FZ,U,3)="B9",$P(FZ,U,15)="Y",$P(FZ,U,18)'="Y" S FBSTAT="R"
;
; update batch
S FBFDA(161.7,FBN_",",11)=FBSTAT ; STATUS
S FBFDA(161.7,FBN_",",12)="@" ; DATE TRANSMITTED
S FBFDA(161.7,FBN_",",23)=DUZ ; STATUS SET TO RETRANSMIT BY
S FBFDA(161.7,FBN_",",24)=DT ; STATUS SET TO RETRANSMIT DATE
D FILE^DIE("","FBFDA")
I $D(DIERR) W !,"Error updating batch file."
E W !,"Batch status was updated. It will be included with the next transmission."
D CLEAN^DILF
Q
;
ACTF ; action F (flag as rejected)
N FBAAB,FBAAOB,FBAAON,FBEMPTY,FBTYPE,FBX,FZ
;
S FZ=$G(^FBAA(161.7,FBN,0))
S FBAAB=$P(FZ,"^"),FBTYPE=$P(FZ,"^",3)
S FBAAON=$P(FZ,"^",2),FBAAOB=$P(FZ,"^",8)_"-"_FBAAON
;
; verify that 1358 is avaiable for posting
S FBX=$$CHK1358^FB1358(FBAAOB)
I 'FBX W !,"Batch was not rejected.",!,$P(FBX,U,2) Q
;
; flag all line items as rejected
D
. N B,FBAARA,FBIENS,FBRFLAG,FBRR,J,K,L,M
. S B=FBN
. S FBRR="Rejected by Reprocess Overdue Batch"
. S (FBRFLAG,FBAARA)=0
. I FBTYPE="B2" D ALLT^FBAADD
. I FBTYPE="B3" D ALLM^FBAADD
. I FBTYPE="B5" D ALLP^FBAADD
. I FBTYPE="B9" D ALLC^FBAADD
. ;
. ; update obligation for rejected lines that are posted by batch
. I FBRFLAG D
. . N FBX
. . S FBRFLAG=0
. . Q:FBAARA'>0
. . S FBX=$$POSTBAT^FB1358(FBN,FBAARA,"R")
. . I 'FBX D
. . . W !,"Error posting $"_$FN(FBAARA,",",2)_" to 1358 for batch "_FBAAB
. . . W !," "_$P(FBX,"^",2)
;
; check if batch is empty
S FBEMPTY=1
I FBTYPE="B2",$O(^FBAAC("AD",FBN,0)) S FBEMPTY=0
I FBTYPE="B3",$O(^FBAAC("AC",FBN,0)) S FBEMPTY=0
I FBTYPE="B5",$O(^FBAA(162.1,"AE",FBN,0)) S FBEMPTY=0
I FBTYPE="B9",$O(^FBAAI("AC",FBN,0)) S FBEMPTY=0
;
I 'FBEMPTY D
. W !,"Batch was not completely rejected."
. W !,"There are still payment line items in the batch."
;
I FBEMPTY D
. ; update batch
. S FBFDA(161.7,FBN_",",11)="V" ; STATUS
. S FBFDA(161.7,FBN_",",13)=DT ; DATE FINALIZED
. S FBFDA(161.7,FBN_",",14)=DUZ ; PERSON WHO COMPLETED
. S FBFDA(161.7,FBN_",",25)=1 ; TRANSMITTED BATCH WAS REJECTED
. D FILE^DIE("","FBFDA")
. I $D(DIERR) W !,"Error updating batch file."
. E W !,"Batch was rejected."
. D CLEAN^DILF
;
Q
;FBAADD1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAADD1 5332 printed Dec 13, 2024@01:55:17 Page 2
FBAADD1 ;WOIFO/SAB - REPROCESS OVERDUE BATCH ;4/19/2012
+1 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ; ICRs
+4 ; #2053 FILE^DIE
+5 ; #2054 CLEAN^DILF
+6 ; #10004 EN^DIQ
+7 ; #10006 ^DIC
+8 ; #10026 ^DIR
+9 ; #10103 $$DOW^XLFDT, $$FMADD^XLFDT
+10 ;
+11 WRITE !,"This option is used to reprocess an overdue payment batch."
+12 WRITE !,"A batch is considered overdue if the Payment Batch Result message"
+13 WRITE !,"has not been received by the 3rd weekday after the batch was"
+14 WRITE !,"transmitted to Central Fee."
+15 WRITE !
+16 WRITE !,"The National Service Desk Austin should be contacted to determine"
+17 WRITE !,"the status of the batch before using this option. If Central Fee"
+18 WRITE !,"already has the batch, you should request that Central Fee resend"
+19 WRITE !,"the Payment Batch Result message. If Central Fee does not have"
+20 WRITE !,"the batch then use this option to reprocess it.",!
+21 ;
+22 NEW DA,DIC,DIR,DIRUT,DR,DTOUT,DUOUT,FBACT,FBDT,FBN,X,Y
+23 ;
+24 ; determine date that is 3 weekdays prior to the current date
+25 SET FBDT=$$CALCDT(3,DT)
+26 ;
BT ; select batch
+1 SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQ"
+2 ; status = TRANSMITTED and DATE TRANSMITTED not after FBDT
+3 SET DIC("S")="I ($G(^(""ST""))=""T"")&($P($G(^(0)),""^"",14)'>"_FBDT_")"
+4 DO ^DIC
KILL DIC
if Y<0
GOTO END
+5 LOCK +^FBAA(161.7,+Y):$GET(DILOCKTM,3)
+6 IF '$TEST
WRITE !,"Another user is editing this batch. Try again later."
GOTO BT
+7 SET FBN=+Y
+8 ;
+9 ; display batch
+10 SET DIC="^FBAA(161.7,"
SET DA=FBN
SET DR="0:1;ST"
WRITE !!
DO EN^DIQ
+11 ;
+12 ; confirm help desk was contacted
+13 SET DIR(0)="Y"
+14 SET DIR("A")="Have you confirmed the batch is not in Central Fee"
+15 WRITE !
+16 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
+17 IF 'Y
WRITE !,"Please contact the National Service Desk Austin to determine the batch status."
GOTO END
+18 ;
ASKACT ; ask action
+1 SET DIR(0)="S^R:RETRANSMIT BY RESETTING BATCH STATUS;F:FLAG ENTIRE BATCH AS REJECTED"
+2 SET DIR("A")="What action should be taken to reprocess this batch"
+3 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
+4 SET FBACT=Y
+5 ;
+6 ; confirm action
+7 SET DIR(0)="Y"
SET DIR("B")="NO"
+8 SET DIR("A")="Are you sure you want to "_$SELECT(FBACT="R":"retransmit",1:"reject")_" this batch"
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
if 'Y
GOTO ASKACT
+10 ;
+11 ; perform selected action
+12 IF FBACT="R"
DO ACTR
+13 IF FBACT="F"
DO ACTF
+14 ;
+15 ; display batch
+16 SET DIC="^FBAA(161.7,"
SET DA=FBN
SET DR="0:1;ST"
WRITE !!
DO EN^DIQ
+17 ;
END ;
+1 IF $GET(FBN)
LOCK -^FBAA(161.7,FBN)
+2 QUIT
+3 ;
CALCDT(FBN,FBDT) ; Calculate Date
+1 ; input
+2 ; FBN - (optional) integer, default 3
+3 ; FBDT - (optional) date in FileMan internal format, default today
+4 ; returns date that is FBN workdays before the FBDT
+5 NEW FBC,FBI,FBPDT,FBRET,FBWKDAY
+6 SET (FBDT,FBRET)=$GET(FBDT,DT)
+7 SET FBN=$GET(FBN,3)
+8 SET FBWKDAY="^Monday^Tuesday^Wednesday^Thursday^Friday^"
+9 SET FBC=0
+10 IF FBN>0
FOR FBI=-1:-1
Begin DoDot:1
+11 SET FBPDT=$$FMADD^XLFDT(FBDT,FBI)
+12 IF FBWKDAY[("^"_$$DOW^XLFDT(FBPDT)_"^")
SET FBC=FBC+1
End DoDot:1
IF FBC'<FBN
SET FBRET=FBPDT
QUIT
+13 QUIT FBRET
+14 ;
ACTR ; action R (retransmit)
+1 NEW FBFDA,FBSTAT,FZ
+2 SET FZ=$GET(^FBAA(161.7,FBN,0))
+3 ;
+4 ; determine status immediately prior to T (TRANSMITTED)
+5 ; init as S
SET FBSTAT="S"
+6 ; change to R for civil hospital batch that is not pricer exempt
+7 IF $PIECE(FZ,U,3)="B9"
IF $PIECE(FZ,U,15)="Y"
IF $PIECE(FZ,U,18)'="Y"
SET FBSTAT="R"
+8 ;
+9 ; update batch
+10 ; STATUS
SET FBFDA(161.7,FBN_",",11)=FBSTAT
+11 ; DATE TRANSMITTED
SET FBFDA(161.7,FBN_",",12)="@"
+12 ; STATUS SET TO RETRANSMIT BY
SET FBFDA(161.7,FBN_",",23)=DUZ
+13 ; STATUS SET TO RETRANSMIT DATE
SET FBFDA(161.7,FBN_",",24)=DT
+14 DO FILE^DIE("","FBFDA")
+15 IF $DATA(DIERR)
WRITE !,"Error updating batch file."
+16 IF '$TEST
WRITE !,"Batch status was updated. It will be included with the next transmission."
+17 DO CLEAN^DILF
+18 QUIT
+19 ;
ACTF ; action F (flag as rejected)
+1 NEW FBAAB,FBAAOB,FBAAON,FBEMPTY,FBTYPE,FBX,FZ
+2 ;
+3 SET FZ=$GET(^FBAA(161.7,FBN,0))
+4 SET FBAAB=$PIECE(FZ,"^")
SET FBTYPE=$PIECE(FZ,"^",3)
+5 SET FBAAON=$PIECE(FZ,"^",2)
SET FBAAOB=$PIECE(FZ,"^",8)_"-"_FBAAON
+6 ;
+7 ; verify that 1358 is avaiable for posting
+8 SET FBX=$$CHK1358^FB1358(FBAAOB)
+9 IF 'FBX
WRITE !,"Batch was not rejected.",!,$PIECE(FBX,U,2)
QUIT
+10 ;
+11 ; flag all line items as rejected
+12 Begin DoDot:1
+13 NEW B,FBAARA,FBIENS,FBRFLAG,FBRR,J,K,L,M
+14 SET B=FBN
+15 SET FBRR="Rejected by Reprocess Overdue Batch"
+16 SET (FBRFLAG,FBAARA)=0
+17 IF FBTYPE="B2"
DO ALLT^FBAADD
+18 IF FBTYPE="B3"
DO ALLM^FBAADD
+19 IF FBTYPE="B5"
DO ALLP^FBAADD
+20 IF FBTYPE="B9"
DO ALLC^FBAADD
+21 ;
+22 ; update obligation for rejected lines that are posted by batch
+23 IF FBRFLAG
Begin DoDot:2
+24 NEW FBX
+25 SET FBRFLAG=0
+26 if FBAARA'>0
QUIT
+27 SET FBX=$$POSTBAT^FB1358(FBN,FBAARA,"R")
+28 IF 'FBX
Begin DoDot:3
+29 WRITE !,"Error posting $"_$FNUMBER(FBAARA,",",2)_" to 1358 for batch "_FBAAB
+30 WRITE !," "_$PIECE(FBX,"^",2)
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 ; check if batch is empty
+33 SET FBEMPTY=1
+34 IF FBTYPE="B2"
IF $ORDER(^FBAAC("AD",FBN,0))
SET FBEMPTY=0
+35 IF FBTYPE="B3"
IF $ORDER(^FBAAC("AC",FBN,0))
SET FBEMPTY=0
+36 IF FBTYPE="B5"
IF $ORDER(^FBAA(162.1,"AE",FBN,0))
SET FBEMPTY=0
+37 IF FBTYPE="B9"
IF $ORDER(^FBAAI("AC",FBN,0))
SET FBEMPTY=0
+38 ;
+39 IF 'FBEMPTY
Begin DoDot:1
+40 WRITE !,"Batch was not completely rejected."
+41 WRITE !,"There are still payment line items in the batch."
End DoDot:1
+42 ;
+43 IF FBEMPTY
Begin DoDot:1
+44 ; update batch
+45 ; STATUS
SET FBFDA(161.7,FBN_",",11)="V"
+46 ; DATE FINALIZED
SET FBFDA(161.7,FBN_",",13)=DT
+47 ; PERSON WHO COMPLETED
SET FBFDA(161.7,FBN_",",14)=DUZ
+48 ; TRANSMITTED BATCH WAS REJECTED
SET FBFDA(161.7,FBN_",",25)=1
+49 DO FILE^DIE("","FBFDA")
+50 IF $DATA(DIERR)
WRITE !,"Error updating batch file."
+51 IF '$TEST
WRITE !,"Batch was rejected."
+52 DO CLEAN^DILF
End DoDot:1
+53 ;
+54 QUIT
+55 ;FBAADD1
