FBAAVR3 ;WOIFO/SAB - FINALIZE BATCH (CONT) ;4/10/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
CHKSPLT ; check for split invoices for batch
; input FBN - batch IEN (file 161.7), must be type B3
; output FBLNLST(FBIENS) - array of line items still in batch for
; split invoices
N DIR,DIROUT,DIRUT,DTOUT,FBINLST,X,Y
;
; build list of split invoices
D LSTSPIN(FBN,.FBINLST)
; build list of line items for split invoices
D LSTLN(FBN,.FBINLST,.FBLNLST)
;
I $D(FBINLST) D
. W !,"This batch contains split invoice(s)."
. W !," An invoice is split when some lines on invoice are flagged as"
. W !," rejected and other lines are not flagged as rejected."
. W !," Current policy is to keep all invoice lines together."
. ;
. S DIR(0)="Y",DIR("A")="Do you want a list of split invoices"
. S DIR("B")="YES"
. D ^DIR Q:$D(DIRUT)
. ;
. I Y D
. . N FBDFN,FBIN,FBX
. . ; loop thru split invoices
. . S FBIN="" F S FBIN=$O(FBINLST(FBIN)) Q:FBIN="" D
. . . W !," Invoice ",FBIN," is split"
. . . S FBDFN=0 F S FBDFN=$O(FBINLST(FBIN,FBDFN)) Q:'FBDFN D
. . . . S FBX=FBINLST(FBIN,FBDFN)
. . . . W !," Patient: ",$P(FBX,"^")," with ",$P(FBX,"^",2)," line",$S($P(FBX,"^",2)'=1:"s that are",1:" that is")," not rejected."
. ;
. W !
;
Q
;
LSTSPIN(FBN,FBINLST) ; build list of split invoices for a batch
; input
; FBN - batch IEN file 161.7. must be type B3
; FBINLST - array, passed by reference
; output
; FBLST - initialized and updated
; FBINLST(FBIN)=""
; where FBIN is an invoice number
; note: FBINLST will not be defined if batch is empty
;
N FBDA,FBIENS,FBIN
K FBINLST
Q:'$G(FBN)
;
; loop thru rejected lines for batch
S FBDA(3)=0 F S FBDA(3)=$O(^FBAAC("AH",FBN,FBDA(3))) Q:'FBDA(3) D
. S FBDA(2)=0
. F S FBDA(2)=$O(^FBAAC("AH",FBN,FBDA(3),FBDA(2))) Q:'FBDA(2) D
. . S FBDA(1)=0
. . F S FBDA(1)=$O(^FBAAC("AH",FBN,FBDA(3),FBDA(2),FBDA(1))) Q:'FBDA(1) D
. . . S FBDA=0
. . . F S FBDA=$O(^FBAAC("AH",FBN,FBDA(3),FBDA(2),FBDA(1),FBDA)) Q:'FBDA D
. . . . S FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
. . . . S FBIN=$$GET1^DIQ(162.03,FBIENS,14) ; INVOICE NUMBER
. . . . Q:FBIN=""
. . . . Q:'$D(^FBAAC("AJ",FBN,FBIN)) ; no unrejected lines in batch
. . . . S FBINLST(FBIN)="" ; add to list of split invoices
;
Q
;
LSTLN(FBN,FBINLST,FBLNLST) ; build list of line items
; input
; FBN - batch IEN file 161.7. must be type B3
; FBINLST - array of invoices, passed by reference
; FBINLST(FBIN)
; where FBIN is an invoice number
; FBLNLST - array of line items, passed by reference
; output
; FBINLST - array of invoices, passed by reference
; will be updated by adding the following node
; FBINLST(FBIN,FBDFN)=patient name^line item count
; where FBDFN is the patient IEN (file 161 & file 2)
; FBLNLST - array of line items, passed by reference
; FBLNLST(FBIENS)=""
; where FBIENS is the IENS for a line item,
; FileMan DBS format
; this array will contain a list of line items still in
; input batch FBN for the invoices in input array FBINLST
; Note: array is initialized and will not be defined
; if there are no line items
;
N FBC,FBDA,FBIN
K FBLNLST
Q:'$G(FBN)
;
; loop thru invoices in array
S FBIN="" F S FBIN=$O(FBINLST(FBIN)) Q:FBIN="" D
. ; loop thru patients for invoice in batch
. S FBDA(3)=0
. F S FBDA(3)=$O(^FBAAC("AJ",FBN,FBIN,FBDA(3))) Q:'FBDA(3) D
. . S FBC=0 ; init line count for invoice & patient
. . S FBDA(2)=0
. . F S FBDA(2)=$O(^FBAAC("AJ",FBN,FBIN,FBDA(3),FBDA(2))) Q:'FBDA(2) D
. . . S FBDA(1)=0
. . . F S FBDA(1)=$O(^FBAAC("AJ",FBN,FBIN,FBDA(3),FBDA(2),FBDA(1))) Q:'FBDA(1) D
. . . . S FBDA=0 F S FBDA=$O(^FBAAC("AJ",FBN,FBIN,FBDA(3),FBDA(2),FBDA(1),FBDA)) Q:'FBDA D
. . . . . ; add to line item array
. . . . . S FBLNLST(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",")=""
. . . . . ; increment line count for invoice & patient
. . . . . S FBC=FBC+1
. . ;
. . ; update invoice array with save patient name and line count
. . S FBINLST(FBIN,FBDA(3))=$$GET1^DIQ(161,FBDA(3),.01)_"^"_FBC
;
Q
;
;FBAAVR3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVR3 4449 printed Oct 16, 2024@17:58:04 Page 2
FBAAVR3 ;WOIFO/SAB - FINALIZE BATCH (CONT) ;4/10/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 QUIT
+4 ;
CHKSPLT ; check for split invoices for batch
+1 ; input FBN - batch IEN (file 161.7), must be type B3
+2 ; output FBLNLST(FBIENS) - array of line items still in batch for
+3 ; split invoices
+4 NEW DIR,DIROUT,DIRUT,DTOUT,FBINLST,X,Y
+5 ;
+6 ; build list of split invoices
+7 DO LSTSPIN(FBN,.FBINLST)
+8 ; build list of line items for split invoices
+9 DO LSTLN(FBN,.FBINLST,.FBLNLST)
+10 ;
+11 IF $DATA(FBINLST)
Begin DoDot:1
+12 WRITE !,"This batch contains split invoice(s)."
+13 WRITE !," An invoice is split when some lines on invoice are flagged as"
+14 WRITE !," rejected and other lines are not flagged as rejected."
+15 WRITE !," Current policy is to keep all invoice lines together."
+16 ;
+17 SET DIR(0)="Y"
SET DIR("A")="Do you want a list of split invoices"
+18 SET DIR("B")="YES"
+19 DO ^DIR
if $DATA(DIRUT)
QUIT
+20 ;
+21 IF Y
Begin DoDot:2
+22 NEW FBDFN,FBIN,FBX
+23 ; loop thru split invoices
+24 SET FBIN=""
FOR
SET FBIN=$ORDER(FBINLST(FBIN))
if FBIN=""
QUIT
Begin DoDot:3
+25 WRITE !," Invoice ",FBIN," is split"
+26 SET FBDFN=0
FOR
SET FBDFN=$ORDER(FBINLST(FBIN,FBDFN))
if 'FBDFN
QUIT
Begin DoDot:4
+27 SET FBX=FBINLST(FBIN,FBDFN)
+28 WRITE !," Patient: ",$PIECE(FBX,"^")," with ",$PIECE(FBX,"^",2)," line",$SELECT($PIECE(FBX,"^",2)'=1:"s that are",1:" that is")," not rejected."
End DoDot:4
End DoDot:3
End DoDot:2
+29 ;
+30 WRITE !
End DoDot:1
+31 ;
+32 QUIT
+33 ;
LSTSPIN(FBN,FBINLST) ; build list of split invoices for a batch
+1 ; input
+2 ; FBN - batch IEN file 161.7. must be type B3
+3 ; FBINLST - array, passed by reference
+4 ; output
+5 ; FBLST - initialized and updated
+6 ; FBINLST(FBIN)=""
+7 ; where FBIN is an invoice number
+8 ; note: FBINLST will not be defined if batch is empty
+9 ;
+10 NEW FBDA,FBIENS,FBIN
+11 KILL FBINLST
+12 if '$GET(FBN)
QUIT
+13 ;
+14 ; loop thru rejected lines for batch
+15 SET FBDA(3)=0
FOR
SET FBDA(3)=$ORDER(^FBAAC("AH",FBN,FBDA(3)))
if 'FBDA(3)
QUIT
Begin DoDot:1
+16 SET FBDA(2)=0
+17 FOR
SET FBDA(2)=$ORDER(^FBAAC("AH",FBN,FBDA(3),FBDA(2)))
if 'FBDA(2)
QUIT
Begin DoDot:2
+18 SET FBDA(1)=0
+19 FOR
SET FBDA(1)=$ORDER(^FBAAC("AH",FBN,FBDA(3),FBDA(2),FBDA(1)))
if 'FBDA(1)
QUIT
Begin DoDot:3
+20 SET FBDA=0
+21 FOR
SET FBDA=$ORDER(^FBAAC("AH",FBN,FBDA(3),FBDA(2),FBDA(1),FBDA))
if 'FBDA
QUIT
Begin DoDot:4
+22 SET FBIENS=FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_","
+23 ; INVOICE NUMBER
SET FBIN=$$GET1^DIQ(162.03,FBIENS,14)
+24 if FBIN=""
QUIT
+25 ; no unrejected lines in batch
if '$DATA(^FBAAC("AJ",FBN,FBIN))
QUIT
+26 ; add to list of split invoices
SET FBINLST(FBIN)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+27 ;
+28 QUIT
+29 ;
LSTLN(FBN,FBINLST,FBLNLST) ; build list of line items
+1 ; input
+2 ; FBN - batch IEN file 161.7. must be type B3
+3 ; FBINLST - array of invoices, passed by reference
+4 ; FBINLST(FBIN)
+5 ; where FBIN is an invoice number
+6 ; FBLNLST - array of line items, passed by reference
+7 ; output
+8 ; FBINLST - array of invoices, passed by reference
+9 ; will be updated by adding the following node
+10 ; FBINLST(FBIN,FBDFN)=patient name^line item count
+11 ; where FBDFN is the patient IEN (file 161 & file 2)
+12 ; FBLNLST - array of line items, passed by reference
+13 ; FBLNLST(FBIENS)=""
+14 ; where FBIENS is the IENS for a line item,
+15 ; FileMan DBS format
+16 ; this array will contain a list of line items still in
+17 ; input batch FBN for the invoices in input array FBINLST
+18 ; Note: array is initialized and will not be defined
+19 ; if there are no line items
+20 ;
+21 NEW FBC,FBDA,FBIN
+22 KILL FBLNLST
+23 if '$GET(FBN)
QUIT
+24 ;
+25 ; loop thru invoices in array
+26 SET FBIN=""
FOR
SET FBIN=$ORDER(FBINLST(FBIN))
if FBIN=""
QUIT
Begin DoDot:1
+27 ; loop thru patients for invoice in batch
+28 SET FBDA(3)=0
+29 FOR
SET FBDA(3)=$ORDER(^FBAAC("AJ",FBN,FBIN,FBDA(3)))
if 'FBDA(3)
QUIT
Begin DoDot:2
+30 ; init line count for invoice & patient
SET FBC=0
+31 SET FBDA(2)=0
+32 FOR
SET FBDA(2)=$ORDER(^FBAAC("AJ",FBN,FBIN,FBDA(3),FBDA(2)))
if 'FBDA(2)
QUIT
Begin DoDot:3
+33 SET FBDA(1)=0
+34 FOR
SET FBDA(1)=$ORDER(^FBAAC("AJ",FBN,FBIN,FBDA(3),FBDA(2),FBDA(1)))
if 'FBDA(1)
QUIT
Begin DoDot:4
+35 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBAAC("AJ",FBN,FBIN,FBDA(3),FBDA(2),FBDA(1),FBDA))
if 'FBDA
QUIT
Begin DoDot:5
+36 ; add to line item array
+37 SET FBLNLST(FBDA_","_FBDA(1)_","_FBDA(2)_","_FBDA(3)_",")=""
+38 ; increment line count for invoice & patient
+39 SET FBC=FBC+1
End DoDot:5
End DoDot:4
End DoDot:3
+40 ;
+41 ; update invoice array with save patient name and line count
+42 SET FBINLST(FBIN,FBDA(3))=$$GET1^DIQ(161,FBDA(3),.01)_"^"_FBC
End DoDot:2
End DoDot:1
+43 ;
+44 QUIT
+45 ;
+46 ;FBAAVR3
