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