Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAADD1

FBAADD1.m

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