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

FBAAPET1.m

Go to the documentation of this file.
  1. FBAAPET1 ;WOIFO/SAB-EDIT PAYMENT ;7/10/2003
  1. ;;3.5;FEE BASIS;**61,123**;JAN 30, 1995;Build 51
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. CKINVEDI(FBFPPSC0,FBFPPSC1,FBAAIN,FBIENSE) ; Check Invoice for EDI
  1. ; Input
  1. ; FBFPPSC0 - old FPPS CLAIM ID
  1. ; FBFPPSC1 - new FPPS CLAIM ID
  1. ; FBAAIN - invoice number
  1. ; FBIENSE - optional, iens of line on invoice that was already edited
  1. ; Result
  1. ; Lines on invoice may be updated (FPPS CLAIM ID, FPPS LINE ITEM)
  1. ;
  1. ; If FBFPPSC0]"",FBFPPSC1="" then EDI changed from YES to NO
  1. ; need to delete FPPS CLAIM ID and FPPS LINE ITEM
  1. ; If FBFPPSC0="",FBFPPSC1]"" then EDI changed from NO to YES
  1. ; need to update FPPS CLAIM ID and prompt FPPS LINE ITEM
  1. ; If FBFPPSC0]"",FBFPPSC1]"",FBFPPSC0'=FBFPPSC1 then
  1. ; EDI stayed YES, but FPPS CLAIM ID was changed
  1. ; need to update FPPS CLAIM ID
  1. ;
  1. N FBASKLN,FBFDA,FBFPPSC,FBFPPSL,FBI,FBIENS,FBMILL,FBUPDLN
  1. ;
  1. S FBIENSE=$G(FBIENSE)
  1. ;
  1. I FBFPPSC0=FBFPPSC1 Q ; FPPS CLAIM ID was not changed
  1. ;
  1. ; Get Lines on Invoice
  1. D MILL(FBAAIN,.FBMILL)
  1. ;
  1. I FBIENSE]"",FBMILL(0)=1 Q ; only 1 line and it has been updated
  1. ;
  1. S (FBASKLN,FBUPDLN)=0
  1. I FBFPPSC0]"",FBFPPSC1="" S (FBFPPSC,FBFPPSL)="@",FBUPDLN=1
  1. I FBFPPSC0="",FBFPPSC1]"" S FBFPPSC=FBFPPSC1,(FBASKLN,FBUPDLN)=1
  1. I FBFPPSC0]"",FBFPPSC1]"" S FBFPPSC=FBFPPSC1
  1. ;
  1. W !,"FPPS CLAIM ID was changed. Updating lines on invoice..."
  1. I FBASKLN D
  1. . W !,"Since EDI Claim from FPPS was changed from NO to YES, the"
  1. . W !,"FPPS LINE ITEM must be entered for each line on the invoice."
  1. ;
  1. ; loop thru lines
  1. S FBI=0 F S FBI=$O(FBMILL(FBI)) Q:'FBI D
  1. . S FBIENS=FBMILL(FBI)
  1. . I FBIENS=FBIENSE Q ; already updated
  1. . S FBFDA(162.03,FBIENS,50)=FBFPPSC
  1. . I FBASKLN D DSPLIL S FBFPPSL=$$FPPSL^FBUTL5(,,1)
  1. . I FBUPDLN,$G(FBFPPSL)]"" S FBFDA(162.03,FBIENS,51)=FBFPPSL
  1. I $D(FBFDA) D FILE^DIE("","FBFDA") D MSG^DIALOG()
  1. ;
  1. Q
  1. ;
  1. MILL(FBAAIN,FBMILL) ; Medical Invoice Line List
  1. ; Input
  1. ; FBAAIN - invoice #
  1. ; FBMILL - array, passed by reference
  1. ; Result
  1. ;
  1. ; Output
  1. ; FBMILL - input array will be updated to contain
  1. ; FBMILL(0)=FBC
  1. ; FBMILL(FBI)=FBIENS
  1. ; Where
  1. ; FBC = number of lines on invoice
  1. ; FBI = integer number
  1. ; FBIENS = internal entry number of line item (subfile 162.03),
  1. ; fileman DBS format
  1. ;
  1. N DA,FBC
  1. ; initialize
  1. K FBMILL
  1. S FBC=0 ; count
  1. ; loop thru x-ref
  1. S DA(3)=0
  1. F S DA(3)=$O(^FBAAC("C",FBAAIN,DA(3))) Q:'DA(3) D
  1. .S DA(2)=0
  1. .F S DA(2)=$O(^FBAAC("C",FBAAIN,DA(3),DA(2))) Q:'DA(2) D
  1. ..S DA(1)=0
  1. ..F S DA(1)=$O(^FBAAC("C",FBAAIN,DA(3),DA(2),DA(1))) Q:'DA(1) D
  1. ...S DA=0
  1. ...F S DA=$O(^FBAAC("C",FBAAIN,DA(3),DA(2),DA(1),DA)) Q:'DA D
  1. ....S FBC=FBC+1
  1. ....S FBMILL(FBC)=DA_","_DA(1)_","_DA(2)_","_DA(3)_","
  1. ; save count of lines
  1. S FBMILL(0)=FBC
  1. Q
  1. ;
  1. DSPLIL ; Display Invoice Line
  1. ; Input
  1. ; FBIENS - iens of line to display
  1. N DA,FBMODA,FBMODL
  1. D DA^DILF(FBIENS,.DA)
  1. D MODDATA^FBAAUTL4(DA(3),DA(2),DA(1),DA)
  1. S FBMODL=$$MODL^FBAAUTL4("FBMODA","E")
  1. W !!
  1. W "SVC DATE: ",$$GET1^DIQ(162.02,DA(1)_","_DA(2)_","_DA(3)_",",.01)
  1. W ?23,"CPT-MOD: ",$$GET1^DIQ(162.03,FBIENS,.01)
  1. I FBMODL]"" W "-",FBMODL
  1. W ?43,"REV. CODE: ",$$GET1^DIQ(162.03,FBIENS,48)
  1. W ?63,"AMT CLAIMED: ",$$GET1^DIQ(162.03,FBIENS,1)
  1. Q
  1. ;
  1. IPACEDIT(FBDD,FBDA,FBIA,FBDODINV,WHICH) ; Enter/Edit IPAC information for all payment types (FB*3.5*123)
  1. ; FBDD - required input. Either 162.03 for Outpatient/Ancillary, or 162.1 for Pharmacy, or 162.5 for Inpatient
  1. ; FBDA - required input. This is the DA(n) array specifying the record to be edited. Note in the case of Inpatient
  1. ; invoices, there is no array but rather the ien to file 162.5.
  1. ; WHICH- Optional input. Null to ask both IPAC Agreement and DOD Invoice Number
  1. ; 1 - Just ask for IPAC Agreement
  1. ; 2 - Just ask for DOD Invoice #
  1. ; Output
  1. ; FBIA - ien to file 161.95 - IPAC agreement ien. Pass by reference to get this value back if needed. Note the FBIA
  1. ; value will be retrieved from the database in this subroutine.
  1. ; FBDODINV - DoD invoice#. Pass by reference to get this value back if needed. Note the FBDODINV value will be
  1. ; retrieved from the database in this subroutine.
  1. ;
  1. ; Function Value is 0/1. 1 means all is good, OK to continue editing
  1. ; 0 means IPAC data is required, but some of it is missing. Error message is displayed.
  1. ;
  1. N FBRET,FBVEN,FBIAEDIT,FBINVDEF,FBZ
  1. S FBRET=1 ; assume function value is true - OK to continue
  1. S:'$D(WHICH) WHICH=""
  1. ;
  1. I FBDD=162.03 D GETIPAC(.FBDA,.FBVEN,.FBIA,.FBDODINV) ; get Outpatient vendor/IPAC data
  1. I FBDD=162.1 D GETIPAC^FBAAEPI(.FBDA,.FBVEN,.FBIA,.FBDODINV) ; get Pharmacy vendor/IPAC data
  1. I FBDD=162.5 D GETIPAC^FBCHEP1(FBDA,.FBVEN,.FBIA,.FBDODINV) ; get Inpatient vendor/IPAC data
  1. ;
  1. S FBINVDEF=FBDODINV ; to be used as the default value
  1. I 'FBVEN G IPEDITX ; get out if no vendor found
  1. ;
  1. ; if any IPAC data exists display it
  1. S FBIAEDIT=0 ; flag indicating if IPAC data in database already
  1. I FBIA!(FBDODINV'="") D
  1. . S FBIAEDIT=1 ; edit to existing data
  1. . D IPACDISP^FBAAMP(FBIA,FBDODINV) ; quick display what is on file now
  1. . Q
  1. ;
  1. ; IPAC data is not required. If it exists ask to remove it, then get out
  1. I '$$IPACREQD^FBAAMP(FBVEN) D G IPEDITX
  1. . I 'FBIAEDIT Q ; no IPAC data on file, immediately get out (normal case)
  1. . I '$$ASKQUES("DEL") Q ; there is some IPAC data, but user doesn't want to delete it
  1. . ;
  1. . I FBDD=162.03 D DELIPAC(.FBDA) ; remove Outpatient IPAC data
  1. . I FBDD=162.1 D DELIPAC^FBAAEPI(.FBDA) ; remove Pharmacy IPAC data
  1. . I FBDD=162.5 D DELIPAC^FBCHEP1(FBDA) ; remove Inpatient IPAC data
  1. . W !,"IPAC Data has been removed.",!
  1. . S (FBIA,FBDODINV)="" ; make variables nil to indicate they have been deleted
  1. . Q
  1. ;
  1. ; IPAC data is required at this point
  1. ;
  1. I FBIAEDIT,'$$ASKQUES("CHANGE") G IE1 ; skip edits if user doesn't want to change it
  1. ;
  1. I WHICH'=2 D
  1. . S FBIA=$$IPAC^FBAAMP(FBVEN) ; get IPAC pointer ien
  1. I WHICH'=1 D
  1. . S FBZ=$$IPACINV^FBAAMP(.FBDODINV,FBINVDEF) ; get DoD Invoice Number
  1. ;
  1. IE1 ; make sure data is there for filing
  1. I WHICH'=2,FBIA'>0 S FBRET=0 G IPEDITX
  1. I WHICH'=1,FBDODINV="" S FBRET=0 G IPEDITX
  1. ;
  1. I FBDD=162.03 D SAVEIPAC(.FBDA,FBIA,FBDODINV,WHICH) ; Store Outpatient IPAC data
  1. I FBDD=162.1 D SAVEIPAC^FBAAEPI(.FBDA,FBIA,FBDODINV,WHICH) ; Store Pharmacy IPAC data
  1. I FBDD=162.5 ; n/a for Inpatient. Variables FBIA and FBDODINV set and returned to
  1. ; calling application for use by template [FBCH EDIT PAYMENT]
  1. IPEDITX ;
  1. I 'FBRET W !!,$C(7),"Required IPAC data is missing. Editing halted for this "_$S(FBDD=162.03:"line item",1:"invoice")_".",!
  1. Q FBRET
  1. ;
  1. ASKQUES(Z) ; Ask user a Yes/No question related to IPAC processing
  1. ; Function value is 1 if the answer is Yes, 0 Otherwise
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,RET
  1. S DIR(0)="Y"
  1. I Z="CHANGE" S DIR("A")="Do you want to modify the IPAC data",DIR("B")="No"
  1. I Z="DEL" S DIR("A",1)="IPAC data is not applicable for this vendor.",DIR("A")="Do you want to delete the IPAC data",DIR("B")="Yes"
  1. W ! D ^DIR K DIR
  1. I $D(DIRUT) W " Not "_$S(Z="CHANGE":"modifying",1:"deleting")_" the IPAC data ... "
  1. I Y S RET=1
  1. E S RET=0
  1. W !
  1. Q RET
  1. ;
  1. GETIPAC(FBDA,FBVEN,FBIA,FBDODINV) ; Get vendor/IPAC data for Outpatient
  1. ; All parameters required and assumed to exist
  1. N GX3
  1. S FBVEN=FBDA(2) ; vendor ien
  1. S GX3=$G(^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,3)) ; 3 node of file 162.03
  1. S FBIA=+$P(GX3,U,6) ; IPAC agreement ien
  1. S FBDODINV=$P(GX3,U,7) ; DoD invoice#
  1. Q
  1. ;
  1. DELIPAC(FBDA) ; Delete all IPAC data on file for Outpatient
  1. N FBIENS,FBIAFDA
  1. S FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
  1. S FBIAFDA(162.03,FBIENS,.05)="" ; IPAC agreement ien
  1. S FBIAFDA(162.03,FBIENS,.055)="" ; DoD invoice#
  1. D FILE^DIE("","FBIAFDA") ; remove them
  1. Q
  1. ;
  1. SAVEIPAC(FBDA,FBIA,FBDODINV,WHICH) ; Store IPAC data into the database for Outpatient
  1. N FBIENS,FBIAFDA
  1. S:'$D(WHICH) WHICH=""
  1. S FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
  1. S:WHICH'=2 FBIAFDA(162.03,FBIENS,.05)=FBIA ; IPAC agreement ien
  1. S:WHICH'=1 FBIAFDA(162.03,FBIENS,.055)=FBDODINV ; DoD invoice#
  1. D FILE^DIE("","FBIAFDA") ; File the data
  1. Q
  1. ;
  1. ;FBAAPET1