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

FBAAFED.m

Go to the documentation of this file. 
  1. FBAAFED ;WOIFO/SAB - FPPS DATA EDIT OUTPATIENT/ANCILLARY INVOICE ;5/15/14  12:49
  1.  ;;3.5;FEE BASIS;**61,154**;JAN 30, 1995;Build 12
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  S FBAAOUT=0
  1.  F  D INVED Q:FBAAOUT
  1.  D CLEAN
  1.  Q
  1.  ;
  1. INVED ; Invoice Edit
  1.  ;
  1. ASKINV ; Select Invoice to Edit
  1.  W !
  1.  S DIR(0)="NO",DIR("A")="Select Invoice Number"
  1.  S DIR("?")="^D HELP^FBAAPIN1"
  1.  D ^DIR K DIR I $D(DIRUT)!(Y="") S FBAAOUT=1 Q
  1.  I '$D(^FBAAC("C",Y)) W !,$C(7),"Invalid selection.",! G ASKINV
  1.  S FBAAIN=Y
  1.  ;
  1.  I $$CKFPPS^FBFHLL(FBAAIN)'=1 D  G ASKINV
  1.  . W !?5,"Invoice ",FBAAIN," has not been transmitted to FPPS."
  1.  ;
  1.  ; Get Lines on Invoice
  1.  D MILL^FBAAPET1(FBAAIN,.FBMILL)
  1.  ;
  1.  ; Determine Vendor and FPPS CLAIM ID based on first line on invoice
  1.  S FBIENS=FBMILL($O(FBMILL(0)))
  1.  S FBV=$P(FBIENS,",",3)
  1.  S (FBFPPSC,FBFPPSC(0))=$$GET1^DIQ(162.03,FBIENS,50)
  1.  ;
  1.  I FBFPPSC="" D  G ASKINV
  1.  . W !,$C(7),"Only EDI Claims can be selected!"
  1.  ;
  1.  S FBINVCHG=0 ; initialize invoice changed flag
  1.  ;
  1. EDITFC ; edit FPPS CLAIM ID
  1.  S FBX=$$FPPSC^FBUTL5(1,FBFPPSC)
  1.  I FBX=-1 S FBAAOUT=1 G INVEDX
  1.  ; need to verify if following restriction is appropriate
  1.  I FBX="" D  G EDITFC
  1.  . W !,$C(7),"Can not change EDI from YES to NO on invoice that has been sent to FPPS!"
  1.  S FBFPPSC=FBX
  1.  ;
  1.  ; if FPPS CLAIM ID changed, then update file, audit log, and lines
  1.  I FBFPPSC'=FBFPPSC(0) D
  1.  . ; set invoice changed flag
  1.  . S FBINVCHG=1
  1.  . ;
  1.  . K FBFDA
  1.  . ; loop thru lines on invoice
  1.  . S FBI=0 F  S FBI=$O(FBMILL(FBI)) Q:'FBI  D
  1.  . . S FBIENS=FBMILL(FBI)
  1.  . . ; file data in 162.03 for each line
  1.  . . S FBFDA(162.03,FBIENS,50)=$S(FBFPPSC="":"@",1:FBFPPSC)
  1.  . . ;
  1.  . . ; add record to audit log
  1.  . . K FBFDAA
  1.  . . S FBFDAA(163.7,"+1,",.01)=FBAAIN ; invoice number
  1.  . . S FBFDAA(163.7,"+1,",1)=$$NOW^XLFDT() ; date/time changed
  1.  . . S FBFDAA(163.7,"+1,",2)=162.03 ; file #
  1.  . . S FBFDAA(163.7,"+1,",3)=FBIENS ; iens
  1.  . . S FBFDAA(163.7,"+1,",4)=50 ; field #
  1.  . . S FBFDAA(163.7,"+1,",5)=FBFPPSC(0) ; old value
  1.  . . S FBFDAA(163.7,"+1,",6)=FBFPPSC ; new value
  1.  . . S FBFDAA(163.7,"+1,",7)=DUZ ; user
  1.  . . I $D(FBFDAA) D UPDATE^DIE("","FBFDAA") D MSG^DIALOG()
  1.  . . ;
  1.  . I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
  1.  ;
  1. ASKLINE ; Select Line to Edit
  1.  ;
  1. ASKPT ; Select Patient
  1.  W !
  1.  S DIC="^FBAAC(",DIC(0)="AEQM"
  1.  D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G INVEDX
  1.  I Y'>0 D  G:$D(DIRUT) INVEDX G:'Y ASKPT G INVEDX
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Are you finished entering patients for this invoice"
  1.  . D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1
  1.  S FBDA(3)=+Y
  1.  ;
  1. ASKVEN ; Select Vendor
  1.  W !
  1.  ;S DIC(0)="AEQM"
  1.  ;S DIC="^FBAAC("_FBDA(3)_",1,"
  1.  ;D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G INVEDX
  1.  ;I Y'>0 D  G:$D(DIRUT) INVEDX G:'Y ASKVEN G ASKPT
  1.  ;. S DIR(0)="Y"
  1.  ;. S DIR("A")="Are you finished entering vendors for this patient"
  1.  ;. D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1
  1.  ;S FBDA(2)=+Y
  1.  S FBDA(2)=FBV
  1.  W !,"Vendor = ",$P($G(^FBAAV(FBV,0)),U)
  1.  ;
  1. ASKDOS ; Select Date of Service
  1.  W !
  1.  S DIC(0)="AEQM"
  1.  S DIC="^FBAAC("_FBDA(3)_",1,"_FBDA(2)_",1,"
  1.  S DIC("A")="Select DATE OF SERVICE: "
  1.  D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G INVEDX
  1.  I Y'>0 D  G:$D(DIRUT) INVEDX G:'Y ASKDOS G ASKPT
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Are you finished entering dates for this patient"
  1.  . D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1
  1.  S FBDA(1)=+Y
  1.  ;
  1. ASKSVC ; Select Service Provided
  1.  W !
  1.  S DIC(0)="AEQM"
  1.  S DIC="^FBAAC("_FBDA(3)_",1,"_FBDA(2)_",1,"_FBDA(1)_",1,"
  1.  D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G INVEDX
  1.  I Y'>0 D  G:$D(DIRUT) INVEDX G:'Y ASKSVC G ASKDOS
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Are you finished entering services for this date"
  1.  . D ^DIR K DIR I $D(DIRUT) S FBAAOUT=1
  1.  S FBDA=+Y
  1.  ;
  1.  S FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
  1.  ;
  1.  ; check if line is on invoice
  1.  I $$GET1^DIQ(162.03,FBIENS,14)'=FBAAIN D  G ASKSVC
  1.  . W $C(7),!,"Line is not on invoice ",FBAAIN,"!"
  1.  ;
  1.  ; get current value of FPPS LINE ITEM to use as default
  1.  S (FBFPPSL(0),FBFPPSL)=$$GET1^DIQ(162.03,FBIENS,51)
  1.  ;
  1. EDITFL ; edit FPPS Line Item
  1.  S FBX=$$FPPSL^FBUTL5(FBFPPSL)
  1.  I FBX=-1 S FBAAOUT=1 G INVEDX
  1.  ; need to verify if following restriction is appropriate
  1.  S FBFPPSL=FBX
  1.  ;
  1.  ; if FPPS LINE ITEM changed, then update file and audit log
  1.  I FBFPPSL'=FBFPPSL(0) D
  1.  . ; set invoice changed flag
  1.  . S FBINVCHG=1
  1.  . ;
  1.  . ; file data in 162.03
  1.  . K FBFDA
  1.  . S FBFDA(162.03,FBIENS,51)=FBFPPSL
  1.  . I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
  1.  . ;
  1.  . ; add record to audit log
  1.  . K FBFDA
  1.  . S FBFDA(163.7,"+1,",.01)=FBAAIN ; invoice number
  1.  . S FBFDA(163.7,"+1,",1)=$$NOW^XLFDT() ; date/time changed
  1.  . S FBFDA(163.7,"+1,",2)=162.03 ; file #
  1.  . S FBFDA(163.7,"+1,",3)=FBIENS ; iens
  1.  . S FBFDA(163.7,"+1,",4)=51 ; field #
  1.  . S FBFDA(163.7,"+1,",5)=FBFPPSL(0) ; old value
  1.  . S FBFDA(163.7,"+1,",6)=FBFPPSL ; new value
  1.  . S FBFDA(163.7,"+1,",7)=DUZ ; user
  1.  . I $D(FBFDA) D UPDATE^DIE("","FBFDA") D MSG^DIALOG()
  1.  ;
  1.  G ASKSVC
  1.  ;
  1. INVEDX ; Invoice Edit Exit
  1.  ; if invoice changed then queue for retransmit to FPPS
  1.  I FBINVCHG D FILEQUE^FBFHLL(FBAAIN,3)
  1.  Q
  1.  ;
  1. CLEAN K D,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  K FBAAIN,FBAAOUT,FBDA,FBFDA,FBFDAA,FBIENS,FBFPPSC,FBFPPSL,FBINVCHG
  1.  K FBMILL,FBV,FBX
  1.  Q
  1.  ;FBAAFED