FBXIP116 ;DALOI/KML-PATCH INSTALL ROUTINE ; 11/19/2010
;;3.5;FEE BASIS;**116**;JAN 30, 1995;Build 30
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q:'$G(XPDENV) ; routine is to be called only during install package option
; check for invoices totaling $0 that exist in batches that are "in-process"
; batches to examine are those that are in statuses of:
; "C" = CLERK CLOSED
; "R" = REVIEWED AFTER PRICER
; "S" = SUPERVISOR CLOSED
; if any zero dollar invoices exist
; the invoices will need to be reported and the patch install cannot occur
W !,"Environmental check routine is executing."
N DD,DO,DIE,DR,X,Y
N FBSTAT,FBX,FB0,FBT,FBN,FBBATCH,FBINV
K ^TMP("FBXIP116")
F FBSTAT="C","R","S" D
. S FBN=0
. F S FBN=$O(^FBAA(161.7,"AC",FBSTAT,FBN)) Q:'FBN D
. . S FB0=$G(^FBAA(161.7,FBN,0))
. . S FBT=$P(FB0,U,3),FBBATCH=$P(FB0,U)
. . I FBT]"","B3,B5,B9"[FBT D @FBT
I $D(FBINV) D GZERO
I $D(XPDABORT) W !,$C(7),"There are invoices that need further processing before installation of patch can be performed.",!,"Installation of patch has terminated"
Q
;
B3 ; process outpatient/ancillary batch
Q:FBT'="B3"
N DA,FBAAIN,FBAMTPD,FBY0
; loop thru items in batch and build list of 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
. . . . 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(3,FBBATCH,FBAAIN)=$G(FBINV(3,FBBATCH,FBAAIN))+FBAMTPD
Q
;
B5 ; processes pharmacy batch
Q:FBT'="B5"
N DA,FBAAIN,FBAMTPD,FBRXY0,FBY0
;
; loop thru items in batch and build list of 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))
. . S FBAAIN=$P(FBY0,U)
. . S FBAMTPD=$P(FBRXY0,U,16)
. . I FBAAIN]"" S FBINV(5,FBBATCH,FBAAIN)=$G(FBINV(5,FBBATCH,FBAAIN))+FBAMTPD
Q
;
B9 ; processes inpatient batch
Q:FBT'="B9"
N DA,FBAAIN,FBAMTPD,FBY0
;
; loop thru items in batch and save zero dollar invoices
S DA=0 F S DA=$O(^FBAAI("AC",FBN,DA)) Q:'DA D
. S FBY0=$G(^FBAAI(DA,0))
. S FBAAIN=$P(FBY0,U)
. S FBAMTPD=$P(FBY0,U,9)
. Q:+FBAMTPD>0
. S FBINV(9,FBBATCH,FBAAIN)=""
Q
;
GZERO ; loop thru invoices and save invoices with 0.00 payment
N FBT,FBAAIN,FBBN
S (FBBN,FBAAIN)=0
F FBT=3,5,9 D
. F S FBBN=$O(FBINV(FBT,FBBN)) Q:FBBN="" D
. . F S FBAAIN=$O(FBINV(FBT,FBBN,FBAAIN)) Q:FBAAIN="" D
. . . I +FBINV(FBT,FBBN,FBAAIN)'>0 S FBINV(FBT,FBBN,FBAAIN)="" Q
. . . K FBINV(FBT,FBBN,FBAAIN)
I $D(FBINV) S XPDABORT=2 D BULLETIN
Q
;
BULLETIN ;
N FBT,FBI,FBBN,FBL,FBTYP
S ^TMP("FBXIP116",$J,1)="The Fee Basis patch FB*3.5*116 did not get installed because there exist"
S ^TMP("FBXIP116",$J,2)="invoice(s) in Fee Basis payment batches that have a total AMOUNT PAID of "
S ^TMP("FBXIP116",$J,3)="$0.00. Once patch 116 is installed the system will not allow an invoice"
S ^TMP("FBXIP116",$J,4)="that totals $0. The patch will also begin the transmission of 0.00"
S ^TMP("FBXIP116",$J,5)="payment lines to Central Fee in Austin; however, $0 invoices are not"
S ^TMP("FBXIP116",$J,6)="accepted by FMS. There are one or two actions that must be taken before"
S ^TMP("FBXIP116",$J,7)="patch 116 can be installed on your system:"
S ^TMP("FBXIP116",$J,8)="1. Execute the Queue Data for Transmission option to transmit the"
S ^TMP("FBXIP116",$J,9)=" batches with the $0 invoices since pre-patched software will prevent"
S ^TMP("FBXIP116",$J,10)=" $0 payment lines from being transmitted to Central Fee."
S ^TMP("FBXIP116",$J,11)="2. If a given batch is in a pre-released state ('CLOSED' or 'REVIEWED"
S ^TMP("FBXIP116",$J,12)=" AFTER PRICER'), the batch can be re-opened and the invoice(s) can be"
S ^TMP("FBXIP116",$J,13)=" edited to have an AMOUNT PAID greater than 0.00 or the invoice(s)"
S ^TMP("FBXIP116",$J,14)=" will need to be removed from the associated batch."
S ^TMP("FBXIP116",$J,15)=""
S ^TMP("FBXIP116",$J,16)="Once the invoices have been reconciled, the Fee Basis patch can be installed."
S ^TMP("FBXIP116",$J,17)=""
S ^TMP("FBXIP116",$J,18)=" Invoice(s) Totaling Zero Dollars"
S ^TMP("FBXIP116",$J,19)="Batch Type Batch Invoice"
S ^TMP("FBXIP116",$J,20)="====================================================="
S FBL=20,(FBBN,FBI)=0
F FBT=3,5,9 D
. S FBTYP=$S(FBT=3:"Medical Fee",FBT=5:"Pharmacy",FBT=9:"Civil Hospital",1:"*****")
. I $D(FBINV(FBT)) F S FBBN=$O(FBINV(FBT,FBBN)) Q:'FBBN D
. . F S FBI=$O(FBINV(FBT,FBBN,FBI)) Q:'FBI D
. . . S FBL=FBL+1,^TMP("FBXIP116",$J,FBL)=FBTYP_" "_FBBN_" "_FBI
D SENDMAIL
Q
;
SENDMAIL ;
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
S XMSUB="FB*3.5*116 - Zero Dollar Invoices exist."
S XMDUZ=.5
S XMTEXT="^TMP(""FBXIP116"",$J,"
S XMY("G.FEE")="",XMY(DUZ)=""
D ^XMD
Q
;
TEST ; loop thru invoices and save invoices with 0.00 payment
S CNT=0,BN=12300,INV=17900
F FBT=3,5,9 D
. F I=1:1:25 S CNT=CNT+1,BN=BN+CNT,INV=INV+CNT,FBINV(FBT,BN,INV)=""
D BULLETIN
Q
;
;FBXIP116
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP116 5516 printed Sep 23, 2025@19:37:14 Page 2
FBXIP116 ;DALOI/KML-PATCH INSTALL ROUTINE ; 11/19/2010
+1 ;;3.5;FEE BASIS;**116**;JAN 30, 1995;Build 30
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; routine is to be called only during install package option
if '$GET(XPDENV)
QUIT
+5 ; check for invoices totaling $0 that exist in batches that are "in-process"
+6 ; batches to examine are those that are in statuses of:
+7 ; "C" = CLERK CLOSED
+8 ; "R" = REVIEWED AFTER PRICER
+9 ; "S" = SUPERVISOR CLOSED
+10 ; if any zero dollar invoices exist
+11 ; the invoices will need to be reported and the patch install cannot occur
+12 WRITE !,"Environmental check routine is executing."
+13 NEW DD,DO,DIE,DR,X,Y
+14 NEW FBSTAT,FBX,FB0,FBT,FBN,FBBATCH,FBINV
+15 KILL ^TMP("FBXIP116")
+16 FOR FBSTAT="C","R","S"
Begin DoDot:1
+17 SET FBN=0
+18 FOR
SET FBN=$ORDER(^FBAA(161.7,"AC",FBSTAT,FBN))
if 'FBN
QUIT
Begin DoDot:2
+19 SET FB0=$GET(^FBAA(161.7,FBN,0))
+20 SET FBT=$PIECE(FB0,U,3)
SET FBBATCH=$PIECE(FB0,U)
+21 IF FBT]""
IF "B3,B5,B9"[FBT
DO @FBT
End DoDot:2
End DoDot:1
+22 IF $DATA(FBINV)
DO GZERO
+23 IF $DATA(XPDABORT)
WRITE !,$CHAR(7),"There are invoices that need further processing before installation of patch can be performed.",!,"Installation of patch has terminated"
+24 QUIT
+25 ;
B3 ; process outpatient/ancillary batch
+1 if FBT'="B3"
QUIT
+2 NEW DA,FBAAIN,FBAMTPD,FBY0
+3 ; loop thru items in batch and build list of invoices and their $
+4 SET DA(3)=0
FOR
SET DA(3)=$ORDER(^FBAAC("AC",FBN,DA(3)))
if 'DA(3)
QUIT
Begin DoDot:1
+5 SET DA(2)=0
FOR
SET DA(2)=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2)))
if 'DA(2)
QUIT
Begin DoDot:2
+6 SET DA(1)=0
+7 FOR
SET DA(1)=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2),DA(1)))
if 'DA(1)
QUIT
Begin DoDot:3
+8 SET DA=0
+9 FOR
SET DA=$ORDER(^FBAAC("AC",FBN,DA(3),DA(2),DA(1),DA))
if 'DA
QUIT
Begin DoDot:4
+10 SET FBY0=$GET(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0))
+11 SET FBAAIN=$PIECE(FBY0,U,16)
+12 SET FBAMTPD=$PIECE(FBY0,U,3)
+13 IF FBAAIN]""
SET FBINV(3,FBBATCH,FBAAIN)=$GET(FBINV(3,FBBATCH,FBAAIN))+FBAMTPD
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
B5 ; processes pharmacy batch
+1 if FBT'="B5"
QUIT
+2 NEW DA,FBAAIN,FBAMTPD,FBRXY0,FBY0
+3 ;
+4 ; loop thru items in batch and build list of 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 SET FBAAIN=$PIECE(FBY0,U)
+10 SET FBAMTPD=$PIECE(FBRXY0,U,16)
+11 IF FBAAIN]""
SET FBINV(5,FBBATCH,FBAAIN)=$GET(FBINV(5,FBBATCH,FBAAIN))+FBAMTPD
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
B9 ; processes inpatient batch
+1 if FBT'="B9"
QUIT
+2 NEW DA,FBAAIN,FBAMTPD,FBY0
+3 ;
+4 ; loop thru items in batch and save zero dollar invoices
+5 SET DA=0
FOR
SET DA=$ORDER(^FBAAI("AC",FBN,DA))
if 'DA
QUIT
Begin DoDot:1
+6 SET FBY0=$GET(^FBAAI(DA,0))
+7 SET FBAAIN=$PIECE(FBY0,U)
+8 SET FBAMTPD=$PIECE(FBY0,U,9)
+9 if +FBAMTPD>0
QUIT
+10 SET FBINV(9,FBBATCH,FBAAIN)=""
End DoDot:1
+11 QUIT
+12 ;
GZERO ; loop thru invoices and save invoices with 0.00 payment
+1 NEW FBT,FBAAIN,FBBN
+2 SET (FBBN,FBAAIN)=0
+3 FOR FBT=3,5,9
Begin DoDot:1
+4 FOR
SET FBBN=$ORDER(FBINV(FBT,FBBN))
if FBBN=""
QUIT
Begin DoDot:2
+5 FOR
SET FBAAIN=$ORDER(FBINV(FBT,FBBN,FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:3
+6 IF +FBINV(FBT,FBBN,FBAAIN)'>0
SET FBINV(FBT,FBBN,FBAAIN)=""
QUIT
+7 KILL FBINV(FBT,FBBN,FBAAIN)
End DoDot:3
End DoDot:2
End DoDot:1
+8 IF $DATA(FBINV)
SET XPDABORT=2
DO BULLETIN
+9 QUIT
+10 ;
BULLETIN ;
+1 NEW FBT,FBI,FBBN,FBL,FBTYP
+2 SET ^TMP("FBXIP116",$JOB,1)="The Fee Basis patch FB*3.5*116 did not get installed because there exist"
+3 SET ^TMP("FBXIP116",$JOB,2)="invoice(s) in Fee Basis payment batches that have a total AMOUNT PAID of "
+4 SET ^TMP("FBXIP116",$JOB,3)="$0.00. Once patch 116 is installed the system will not allow an invoice"
+5 SET ^TMP("FBXIP116",$JOB,4)="that totals $0. The patch will also begin the transmission of 0.00"
+6 SET ^TMP("FBXIP116",$JOB,5)="payment lines to Central Fee in Austin; however, $0 invoices are not"
+7 SET ^TMP("FBXIP116",$JOB,6)="accepted by FMS. There are one or two actions that must be taken before"
+8 SET ^TMP("FBXIP116",$JOB,7)="patch 116 can be installed on your system:"
+9 SET ^TMP("FBXIP116",$JOB,8)="1. Execute the Queue Data for Transmission option to transmit the"
+10 SET ^TMP("FBXIP116",$JOB,9)=" batches with the $0 invoices since pre-patched software will prevent"
+11 SET ^TMP("FBXIP116",$JOB,10)=" $0 payment lines from being transmitted to Central Fee."
+12 SET ^TMP("FBXIP116",$JOB,11)="2. If a given batch is in a pre-released state ('CLOSED' or 'REVIEWED"
+13 SET ^TMP("FBXIP116",$JOB,12)=" AFTER PRICER'), the batch can be re-opened and the invoice(s) can be"
+14 SET ^TMP("FBXIP116",$JOB,13)=" edited to have an AMOUNT PAID greater than 0.00 or the invoice(s)"
+15 SET ^TMP("FBXIP116",$JOB,14)=" will need to be removed from the associated batch."
+16 SET ^TMP("FBXIP116",$JOB,15)=""
+17 SET ^TMP("FBXIP116",$JOB,16)="Once the invoices have been reconciled, the Fee Basis patch can be installed."
+18 SET ^TMP("FBXIP116",$JOB,17)=""
+19 SET ^TMP("FBXIP116",$JOB,18)=" Invoice(s) Totaling Zero Dollars"
+20 SET ^TMP("FBXIP116",$JOB,19)="Batch Type Batch Invoice"
+21 SET ^TMP("FBXIP116",$JOB,20)="====================================================="
+22 SET FBL=20
SET (FBBN,FBI)=0
+23 FOR FBT=3,5,9
Begin DoDot:1
+24 SET FBTYP=$SELECT(FBT=3:"Medical Fee",FBT=5:"Pharmacy",FBT=9:"Civil Hospital",1:"*****")
+25 IF $DATA(FBINV(FBT))
FOR
SET FBBN=$ORDER(FBINV(FBT,FBBN))
if 'FBBN
QUIT
Begin DoDot:2
+26 FOR
SET FBI=$ORDER(FBINV(FBT,FBBN,FBI))
if 'FBI
QUIT
Begin DoDot:3
+27 SET FBL=FBL+1
SET ^TMP("FBXIP116",$JOB,FBL)=FBTYP_" "_FBBN_" "_FBI
End DoDot:3
End DoDot:2
End DoDot:1
+28 DO SENDMAIL
+29 QUIT
+30 ;
SENDMAIL ;
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+2 SET XMSUB="FB*3.5*116 - Zero Dollar Invoices exist."
+3 SET XMDUZ=.5
+4 SET XMTEXT="^TMP(""FBXIP116"",$J,"
+5 SET XMY("G.FEE")=""
SET XMY(DUZ)=""
+6 DO ^XMD
+7 QUIT
+8 ;
TEST ; loop thru invoices and save invoices with 0.00 payment
+1 SET CNT=0
SET BN=12300
SET INV=17900
+2 FOR FBT=3,5,9
Begin DoDot:1
+3 FOR I=1:1:25
SET CNT=CNT+1
SET BN=BN+CNT
SET INV=INV+CNT
SET FBINV(FBT,BN,INV)=""
End DoDot:1
+4 DO BULLETIN
+5 QUIT
+6 ;
+7 ;FBXIP116
