FBFHLL ;AISC/LEG-FPPS QUEUED INVOICE FILE ;9/10/2003
;;3.5;FEE BASIS;**61**;JULY 18, 2003
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
;
LOG(FBN,FBTYPE) ; processes batch and logs 0.00 invoices to FILE #163.5
; input
; FBN - pointer to FEE BASIS BATCH file
; FBTYPE - batch type (B3,B5,B9,BT)
N FBX,FBERR
S FBERR=""
F FBX="FBN","FBTYPE" S:'$L(@FBX) FBERR=FBX_":0 LENGTH"
I $L(FBERR) W FBERR Q
I "B3,B5,B9"[FBTYPE D @FBTYPE ;either B3, B5, B9
Q
;
B3 ; process outpatient/ancillary batch
Q:FBTYPE'="B3"
N DA,FBAAIN,FBAMTPD,FBINV,FBY0
;
; loop thru items in batch and build list of EDI invoices and their $
S DA(3)=0 F S DA(3)=$O(^FBAAC("AC",FBN,DA(3))) Q:'DA(3) D
. S DA(2)=0 F S DA(2)=$O(^FBAAC("AC",FBN,DA(3),DA(2))) Q:'DA(2) D
. . S DA(1)=0
. . F S DA(1)=$O(^FBAAC("AC",FBN,DA(3),DA(2),DA(1))) Q:'DA(1) D
. . . S DA=0
. . . F S DA=$O(^FBAAC("AC",FBN,DA(3),DA(2),DA(1),DA)) Q:'DA D
. . . . Q:$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U)="" ; not EDI
. . . . S FBY0=$G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0))
. . . . S FBAAIN=$P(FBY0,U,16)
. . . . S FBAMTPD=$P(FBY0,U,3)
. . . . I FBAAIN]"" S FBINV(FBAAIN)=$G(FBINV(FBAAIN))+FBAMTPD
;
; loop thru EDI invoices and queue invoices with 0.00 payment
S FBAAIN="" F S FBAAIN=$O(FBINV(FBAAIN)) Q:FBAAIN="" D
. Q:$G(FBINV(FBAAIN))>0 ; not zero dollar invoice
. D FILEQUE(FBAAIN,3)
Q
;
B5 ; processes pharmacy batch
Q:FBTYPE'="B5"
N DA,FBAAIN,FBAMTPD,FBINV,FBRXY0,FBY0
;
; loop thru items in batch and build list of EDI invoices and their $
S DA(1)=0 F S DA(1)=$O(^FBAA(162.1,"AE",FBN,DA(1))) Q:'DA(1) D
. S DA=0 F S DA=$O(^FBAA(162.1,"AE",FBN,DA(1),DA)) Q:'DA D
. . S FBY0=$G(^FBAA(162.1,DA(1),0))
. . S FBRXY0=$G(^FBAA(162.1,DA(1),"RX",DA,0))
. . Q:$P(FBY0,U,13)="" ; not EDI
. . S FBAAIN=$P(FBY0,U)
. . S FBAMTPD=$P(FBRXY0,U,16)
. . I FBAAIN]"" S FBINV(FBAAIN)=$G(FBINV(FBAAIN))+FBAMTPD
;
; loop thru EDI invoices and queue invoices with 0.00 payment
S FBAAIN="" F S FBAAIN=$O(FBINV(FBAAIN)) Q:FBAAIN="" D
. Q:$G(FBINV(FBAAIN))>0 ; not zero dollar invoice
. D FILEQUE(FBAAIN,5)
Q
;
B9 ; processes inpatient batch
Q:FBTYPE'="B9"
N DA,FBAAIN,FBAMTPD,FBY0
;
; loop thru items in batch and log 0.00 EDI invoices
S DA=0 F S DA=$O(^FBAAI("AC",FBN,DA)) Q:'DA D
. Q:$P($G(^FBAAI(DA,3)),U)="" ; not EDI
. S FBY0=$G(^FBAAI(DA,0))
. S FBAAIN=$P(FBY0,U)
. S FBAMTPD=$P(FBY0,U,9)
. Q:FBAMTPD>0 ; not 0.00 invoice
. D FILEQUE(FBAAIN,9)
Q
;
PAIDLOG(FBINV) ; process EDI invoices from payment conf/canc message
; input FBINV array, passed by reference
; format FBINV(fbtype,fbaain)=""
; where fbtype = 3, 5, or 9
; fbaain = invoice number
;
N FBAAIN,FBTYPE
; loop thru type
F FBTYPE=3,5,9 D
. ; loop thru invoices
. S FBAAIN="" F S FBAAIN=$O(FBINV(FBTYPE,FBAAIN)) Q:FBAAIN="" D
. . ; queue invoice
. . D FILEQUE(FBAAIN,FBTYPE)
Q
;
FILEQUE(FBAAIN,FBTYPE) ; file invoice into FPPS Queue
; input
; FBAAIN - invoice number
; FBTYPE - type (3, 5, or 9)
; where 3 = outpatient/ancillary - file 162
; 5 = pharmacy - file 162.1
; 9 = inpatient - file 162.5
;
N FBDA,FBFDA
;
;
S FBDA=$O(^FBHL(163.5,"B",FBAAIN,""),-1) ; last entry for invoice
I FBDA,$D(^FBHL(163.5,"AC",0,FBDA)) Q ; already queued to be sent
;
S FBFDA(163.5,"+1,",.01)=FBAAIN
S FBFDA(163.5,"+1,",1)=FBTYPE
S FBFDA(163.5,"+1,",2)=0
D UPDATE^DIE("","FBFDA")
Q
;
CKFPPS(FBAAIN) ; checks if invoice was previously sent to FPPS
; input
; FBAAIN - invoice number
; result
; status (0,1,X) of 1st entry for invoice in file 163.5
; where 0 = waiting to be transmitted
; 1 = transmitted
; X = not logged
N FBDA,FBRET,FBSTAT
S FBRET=""
;
; loop thru entries for invoice (look until end or return value is true)
S FBDA=0 F S FBDA=$O(^FBHL(163.5,"B",FBAAIN,FBDA)) Q:'FBDA D Q:FBRET
. S FBSTAT=$P($G(^FBHL(163.5,FBDA,0)),U,3)
. I "^1^2^"[(U_FBSTAT_U) S FBRET=1 ; status=transmitted or acknowledged
. I "^0^"[(U_FBSTAT_U) S FBRET=0 ; status=pending
;
; if no status found for invoice then return X for not logged
I FBRET="" S FBRET="X"
Q FBRET
;
;FBFHLL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFHLL 4306 printed Nov 22, 2024@17:08:30 Page 2
FBFHLL ;AISC/LEG-FPPS QUEUED INVOICE FILE ;9/10/2003
+1 ;;3.5;FEE BASIS;**61**;JULY 18, 2003
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
LOG(FBN,FBTYPE) ; processes batch and logs 0.00 invoices to FILE #163.5
+1 ; input
+2 ; FBN - pointer to FEE BASIS BATCH file
+3 ; FBTYPE - batch type (B3,B5,B9,BT)
+4 NEW FBX,FBERR
+5 SET FBERR=""
+6 FOR FBX="FBN","FBTYPE"
if '$LENGTH(@FBX)
SET FBERR=FBX_":0 LENGTH"
+7 IF $LENGTH(FBERR)
WRITE FBERR
QUIT
+8 ;either B3, B5, B9
IF "B3,B5,B9"[FBTYPE
DO @FBTYPE
+9 QUIT
+10 ;
B3 ; process outpatient/ancillary batch
+1 if FBTYPE'="B3"
QUIT
+2 NEW DA,FBAAIN,FBAMTPD,FBINV,FBY0
+3 ;
+4 ; loop thru items in batch and build list of EDI invoices and their $
+5 SET DA(3)=0
FOR
SET DA(3)=$ORDER(^FBAAC("AC",FBN,DA(3)))
if 'DA(3)
QUIT
Begin DoDot:1
+6 SET DA(2)=0
FOR
SET DA(2)=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2)))
if 'DA(2)
QUIT
Begin DoDot:2
+7 SET DA(1)=0
+8 FOR
SET DA(1)=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2),DA(1)))
if 'DA(1)
QUIT
Begin DoDot:3
+9 SET DA=0
+10 FOR
SET DA=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2),DA(1),DA))
if 'DA
QUIT
Begin DoDot:4
+11 ; not EDI
if $PIECE($GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U)=""
QUIT
+12 SET FBY0=$GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0))
+13 SET FBAAIN=$PIECE(FBY0,U,16)
+14 SET FBAMTPD=$PIECE(FBY0,U,3)
+15 IF FBAAIN]""
SET FBINV(FBAAIN)=$GET(FBINV(FBAAIN))+FBAMTPD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 ; loop thru EDI invoices and queue invoices with 0.00 payment
+18 SET FBAAIN=""
FOR
SET FBAAIN=$ORDER(FBINV(FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:1
+19 ; not zero dollar invoice
if $GET(FBINV(FBAAIN))>0
QUIT
+20 DO FILEQUE(FBAAIN,3)
End DoDot:1
+21 QUIT
+22 ;
B5 ; processes pharmacy batch
+1 if FBTYPE'="B5"
QUIT
+2 NEW DA,FBAAIN,FBAMTPD,FBINV,FBRXY0,FBY0
+3 ;
+4 ; loop thru items in batch and build list of EDI invoices and their $
+5 SET DA(1)=0
FOR
SET DA(1)=$ORDER(^FBAA(162.1,"AE",FBN,DA(1)))
if 'DA(1)
QUIT
Begin DoDot:1
+6 SET DA=0
FOR
SET DA=$ORDER(^FBAA(162.1,"AE",FBN,DA(1),DA))
if 'DA
QUIT
Begin DoDot:2
+7 SET FBY0=$GET(^FBAA(162.1,DA(1),0))
+8 SET FBRXY0=$GET(^FBAA(162.1,DA(1),"RX",DA,0))
+9 ; not EDI
if $PIECE(FBY0,U,13)=""
QUIT
+10 SET FBAAIN=$PIECE(FBY0,U)
+11 SET FBAMTPD=$PIECE(FBRXY0,U,16)
+12 IF FBAAIN]""
SET FBINV(FBAAIN)=$GET(FBINV(FBAAIN))+FBAMTPD
End DoDot:2
End DoDot:1
+13 ;
+14 ; loop thru EDI invoices and queue invoices with 0.00 payment
+15 SET FBAAIN=""
FOR
SET FBAAIN=$ORDER(FBINV(FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:1
+16 ; not zero dollar invoice
if $GET(FBINV(FBAAIN))>0
QUIT
+17 DO FILEQUE(FBAAIN,5)
End DoDot:1
+18 QUIT
+19 ;
B9 ; processes inpatient batch
+1 if FBTYPE'="B9"
QUIT
+2 NEW DA,FBAAIN,FBAMTPD,FBY0
+3 ;
+4 ; loop thru items in batch and log 0.00 EDI invoices
+5 SET DA=0
FOR
SET DA=$ORDER(^FBAAI("AC",FBN,DA))
if 'DA
QUIT
Begin DoDot:1
+6 ; not EDI
if $PIECE($GET(^FBAAI(DA,3)),U)=""
QUIT
+7 SET FBY0=$GET(^FBAAI(DA,0))
+8 SET FBAAIN=$PIECE(FBY0,U)
+9 SET FBAMTPD=$PIECE(FBY0,U,9)
+10 ; not 0.00 invoice
if FBAMTPD>0
QUIT
+11 DO FILEQUE(FBAAIN,9)
End DoDot:1
+12 QUIT
+13 ;
PAIDLOG(FBINV) ; process EDI invoices from payment conf/canc message
+1 ; input FBINV array, passed by reference
+2 ; format FBINV(fbtype,fbaain)=""
+3 ; where fbtype = 3, 5, or 9
+4 ; fbaain = invoice number
+5 ;
+6 NEW FBAAIN,FBTYPE
+7 ; loop thru type
+8 FOR FBTYPE=3,5,9
Begin DoDot:1
+9 ; loop thru invoices
+10 SET FBAAIN=""
FOR
SET FBAAIN=$ORDER(FBINV(FBTYPE,FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:2
+11 ; queue invoice
+12 DO FILEQUE(FBAAIN,FBTYPE)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
FILEQUE(FBAAIN,FBTYPE) ; file invoice into FPPS Queue
+1 ; input
+2 ; FBAAIN - invoice number
+3 ; FBTYPE - type (3, 5, or 9)
+4 ; where 3 = outpatient/ancillary - file 162
+5 ; 5 = pharmacy - file 162.1
+6 ; 9 = inpatient - file 162.5
+7 ;
+8 NEW FBDA,FBFDA
+9 ;
+10 ;
+11 ; last entry for invoice
SET FBDA=$ORDER(^FBHL(163.5,"B",FBAAIN,""),-1)
+12 ; already queued to be sent
IF FBDA
IF $DATA(^FBHL(163.5,"AC",0,FBDA))
QUIT
+13 ;
+14 SET FBFDA(163.5,"+1,",.01)=FBAAIN
+15 SET FBFDA(163.5,"+1,",1)=FBTYPE
+16 SET FBFDA(163.5,"+1,",2)=0
+17 DO UPDATE^DIE("","FBFDA")
+18 QUIT
+19 ;
CKFPPS(FBAAIN) ; checks if invoice was previously sent to FPPS
+1 ; input
+2 ; FBAAIN - invoice number
+3 ; result
+4 ; status (0,1,X) of 1st entry for invoice in file 163.5
+5 ; where 0 = waiting to be transmitted
+6 ; 1 = transmitted
+7 ; X = not logged
+8 NEW FBDA,FBRET,FBSTAT
+9 SET FBRET=""
+10 ;
+11 ; loop thru entries for invoice (look until end or return value is true)
+12 SET FBDA=0
FOR
SET FBDA=$ORDER(^FBHL(163.5,"B",FBAAIN,FBDA))
if 'FBDA
QUIT
Begin DoDot:1
+13 SET FBSTAT=$PIECE($GET(^FBHL(163.5,FBDA,0)),U,3)
+14 ; status=transmitted or acknowledged
IF "^1^2^"[(U_FBSTAT_U)
SET FBRET=1
+15 ; status=pending
IF "^0^"[(U_FBSTAT_U)
SET FBRET=0
End DoDot:1
if FBRET
QUIT
+16 ;
+17 ; if no status found for invoice then return X for not logged
+18 IF FBRET=""
SET FBRET="X"
+19 QUIT FBRET
+20 ;
+21 ;FBFHLL
