- 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 Feb 18, 2025@23:21:43 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