IBACCWLAIBILL1 ;EDE/TPF - ACC (Automated Community Care) Claims - Action Items related to actions on a Bill (cont.); 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;This routine contains APIs for Action Items for the ACC Community Care worklists
;
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCBILL EDIT
EDIT ;EP - EDIT BILL.
N DFN,IBENCIFN,IBIFN,IBBILL,IBPOPOUT,IBREEDIT,IBV,IBVIEW,IBER,IBAC,TRANSMITTED,TRANSMITDATE
N TMPIBDA
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
I '$G(IBDA) N IBDA D SEL(.IBDA)
;
I '$D(IBDA) S VALMBCK="R" Q
;
I $G(IBDA(IBDA))["----------------------",'$O(IBDA(IBDA)) S VALMBCK="R" Q
;
;IBPARENT=0 SHOWS IT IS A "CHILD" SCREEN!
I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
.S IBENCIFN=$G(@VALMAR@("IEN3649",1))
.S IBIFN=$G(@VALMAR@("IEN399",1))
E D
.S IBIFN=$G(@VALMAR@(IBDA,"IEN399",1))
.S IBENCIFN=$G(@VALMAR@(IBDA,"IEN3649",1))
;
I IBENCIFN S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND"
;
I $D(@VALMAR@(IBDA,"UNAVAILABLE")) D Q
.W !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
.W !,$G(@VALMAR@(IBDA,"UNAVAILABLE"))
.S VALMBCK="R"
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
I $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED" D Q
.W !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
.W !,"IT HAS BEEN CLOSED!"
.S VALMBCK="R"
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
I IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E D Q
.W !!,"This encounter does not have a K#."
.W !,"THIS ACTION CANNOT BE EXECUTED!!"
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
.S VALMBCK="R"
;
;JWS;8/12/25;EBILL-5442;Users can edit a bill after CB action
I $$GET1^DIQ(399,IBIFN_",",.13,"I")'=1 D Q
. W !,"VistA claim ",$$GET1^DIQ(399,IBIFN_",",.01)," with status of ",$$GET1^DIQ(399,IBIFN_",",.13)," can no longer be edited."
. N DIR ;TPF;IB*2*770v47;EBILL-6042
. D PAUSE^VALM1
. S VALMBCK="R"
. Q
;
W !,"CURRENT STATUS OF ENCOUNTER: ",$$CHKSTATUS^IBACCWLUTIL(IBENCIFN)
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
;S IBNOFIX=1
;DISPLAY EDIT SCREENS
I $G(IBPARENT)=0 D FULL^VALM1 ;TPF;IB*2*770v38;EBILL-5485
S IBREEDIT=1
S IBV=0
;
L +^DGCR(399,IBIFN):5 I '$T D Q
.W !!,"File #399 record is Locked!! Please try again later." S VALMBCK="R"
.N DIR S DIR(0)="E" D ^DIR
;
L +^IBA(364.9,IBENCIFN):5 I '$T D Q
.W !!,"File #364.9 record is Locked!! Please try again later." S VALMBCK="R"
.N DIR S DIR(0)="E" D ^DIR
;
D VIEW1^IBCB2
L -^DGCR(399,IBIFN)
L -^IBA(364.9,IBENCIFN)
I $G(IBPOPOUT) L -^DGCR(399,IBIFN) N DIR D PAUSE^VALM1 S VALMBCK="R" D:'$D(IOUON)!'$D(IORVON) ENS^%ZISS Q ;TPF;IB*2*770v47;EBILL-6042
;
;DISPLAY PROCS. DO 'EDIT CHECKS', ASK AUTHORIZE ETC
S IBVIEW=1
S IBER=1
S IBAC=1
;
I $G(IBPARENT)=0 M TMPIBDA=IBDA ;TPF;IB*2*770v38;EBILL-5485
D ^IBCB1
I $G(IBPARENT)=0 M IBDA=TMPIBDA ;TPF;IB*2*770v38;EBILL-5485
L -^DGCR(399,IBIFN)
L -^DGCR(364.9,IBENCIFN)
;
I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
;
I '$$TRANSMITTED^IBACCWLUTIL1(IBIFN) D Q
.W !!,"Bill "_$G(IBBILL)_" did not transmit." ;TPF;IB*2*770vPURPLE;EBILL-5700
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
.I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
.S VALMBCK="R"
;
W !!,"BILL TRANSMITTED!!"
N DIR ;TPF;IB*2*770v47;EBILL-6042
D PAUSE^VALM1
D UPDSTATUS^IBACCWLUTIL(IBENCIFN,"CLOSED")
S TRANSMITDATE=$$FMTE^XLFDT($$GET1^DIQ(364,IBIFN_",",.14,"I"),"2ZD") ;NOT DOING ANYTHING WITH THIS YET
;
I $G(IBPARENT)=0 D EEPUBLISH^IBACCWLUTIL1(IBDA,.IBFROMVALMDDF,1,.LASTONEPUBLISHED) S VALMBCK="R" Q ;TPF;IB*2*770v38;EBILL-5485,5728
;
;TPF;IB*2*770v38;EBILL-5485
I $G(IBPARENT) K @VALMAR S:VALMBG=VALMLST VALMBG=VALMBG-VALM("LINES") D PULLLIST^IBACCWL1(.IBDAYSMAX,.IBBILLER,.IBDIV,.IBSORT,0) S VALMBCK="R" Q
E S IBICAMEFROMEE=1 S VALMBCK="R" Q ;TPF;IB*2*770v38;EBILL-5485
;
S VALMBCK="R"
;
Q
;
SEL(IBDA,OPTION) ;EP -
K IBDA,VALMY
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),$S($G(OPTION)'="":OPTION,1:"S"))
Q:'$D(VALMY)
;
S IBDA("TOTAL")=0
S IBDA=0
F S IBDA=$O(VALMY(IBDA)) Q:'IBDA D
.S IBDA(IBDA)=$G(@VALMAR@(+IBDA,0))
.S IBDA("TOTAL")=IBDA("TOTAL")+1
S IBDA=$O(IBDA(""))
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLAIBILL1 4416 printed May 25, 2026@12:09:49 Page 2
IBACCWLAIBILL1 ;EDE/TPF - ACC (Automated Community Care) Claims - Action Items related to actions on a Bill (cont.); 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;This routine contains APIs for Action Items for the ACC Community Care worklists
+5 ;
+6 ;CALLED BY ACTION PROTOCOLS:
+7 ;IBACC WL IBACCBILL EDIT
EDIT ;EP - EDIT BILL.
+1 NEW DFN,IBENCIFN,IBIFN,IBBILL,IBPOPOUT,IBREEDIT,IBV,IBVIEW,IBER,IBAC,TRANSMITTED,TRANSMITDATE
+2 NEW TMPIBDA
+3 ;
+4 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+5 ;
+6 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+7 ;
+8 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+9 ;
+10 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+11 ;
+12 ;IBPARENT=0 SHOWS IT IS A "CHILD" SCREEN!
+13 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+14 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+15 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+18 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+19 ;
+20 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+21 IF '$TEST
SET DFN="NOT FOUND"
+22 ;
+23 IF $DATA(@VALMAR@(IBDA,"UNAVAILABLE"))
Begin DoDot:1
+24 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+25 WRITE !,$GET(@VALMAR@(IBDA,"UNAVAILABLE"))
+26 SET VALMBCK="R"
+27 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+28 DO PAUSE^VALM1
End DoDot:1
QUIT
+29 ;
+30 IF $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED"
Begin DoDot:1
+31 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+32 WRITE !,"IT HAS BEEN CLOSED!"
+33 SET VALMBCK="R"
+34 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+35 DO PAUSE^VALM1
End DoDot:1
QUIT
+36 ;
+37 IF IBIFN'=""
Begin DoDot:1
+38 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+39 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+40 IF '$TEST
Begin DoDot:1
+41 WRITE !!,"This encounter does not have a K#."
+42 WRITE !,"THIS ACTION CANNOT BE EXECUTED!!"
+43 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+44 DO PAUSE^VALM1
+45 SET VALMBCK="R"
End DoDot:1
QUIT
+46 ;
+47 ;JWS;8/12/25;EBILL-5442;Users can edit a bill after CB action
+48 IF $$GET1^DIQ(399,IBIFN_",",.13,"I")'=1
Begin DoDot:1
+49 WRITE !,"VistA claim ",$$GET1^DIQ(399,IBIFN_",",.01)," with status of ",$$GET1^DIQ(399,IBIFN_",",.13)," can no longer be edited."
+50 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+51 DO PAUSE^VALM1
+52 SET VALMBCK="R"
+53 QUIT
End DoDot:1
QUIT
+54 ;
+55 WRITE !,"CURRENT STATUS OF ENCOUNTER: ",$$CHKSTATUS^IBACCWLUTIL(IBENCIFN)
+56 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+57 ;
+58 ;S IBNOFIX=1
+59 ;DISPLAY EDIT SCREENS
+60 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
DO FULL^VALM1
+61 SET IBREEDIT=1
+62 SET IBV=0
+63 ;
+64 LOCK +^DGCR(399,IBIFN):5
IF '$TEST
Begin DoDot:1
+65 WRITE !!,"File #399 record is Locked!! Please try again later."
SET VALMBCK="R"
+66 NEW DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+67 ;
+68 LOCK +^IBA(364.9,IBENCIFN):5
IF '$TEST
Begin DoDot:1
+69 WRITE !!,"File #364.9 record is Locked!! Please try again later."
SET VALMBCK="R"
+70 NEW DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+71 ;
+72 DO VIEW1^IBCB2
+73 LOCK -^DGCR(399,IBIFN)
+74 LOCK -^IBA(364.9,IBENCIFN)
+75 ;TPF;IB*2*770v47;EBILL-6042
IF $GET(IBPOPOUT)
LOCK -^DGCR(399,IBIFN)
NEW DIR
DO PAUSE^VALM1
SET VALMBCK="R"
if '$DATA(IOUON)!'$DATA(IORVON)
DO ENS^%ZISS
QUIT
+76 ;
+77 ;DISPLAY PROCS. DO 'EDIT CHECKS', ASK AUTHORIZE ETC
+78 SET IBVIEW=1
+79 SET IBER=1
+80 SET IBAC=1
+81 ;
+82 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
MERGE TMPIBDA=IBDA
+83 DO ^IBCB1
+84 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
MERGE IBDA=TMPIBDA
+85 LOCK -^DGCR(399,IBIFN)
+86 LOCK -^DGCR(364.9,IBENCIFN)
+87 ;
+88 IF '$DATA(IOUON)!'$DATA(IORVON)
DO ENS^%ZISS
+89 ;
+90 IF '$$TRANSMITTED^IBACCWLUTIL1(IBIFN)
Begin DoDot:1
+91 ;TPF;IB*2*770vPURPLE;EBILL-5700
WRITE !!,"Bill "_$GET(IBBILL)_" did not transmit."
+92 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+93 DO PAUSE^VALM1
+94 IF '$DATA(IOUON)!'$DATA(IORVON)
DO ENS^%ZISS
+95 SET VALMBCK="R"
End DoDot:1
QUIT
+96 ;
+97 WRITE !!,"BILL TRANSMITTED!!"
+98 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+99 DO PAUSE^VALM1
+100 DO UPDSTATUS^IBACCWLUTIL(IBENCIFN,"CLOSED")
+101 ;NOT DOING ANYTHING WITH THIS YET
SET TRANSMITDATE=$$FMTE^XLFDT($$GET1^DIQ(364,IBIFN_",",.14,"I"),"2ZD")
+102 ;
+103 ;TPF;IB*2*770v38;EBILL-5485,5728
IF $GET(IBPARENT)=0
DO EEPUBLISH^IBACCWLUTIL1(IBDA,.IBFROMVALMDDF,1,.LASTONEPUBLISHED)
SET VALMBCK="R"
QUIT
+104 ;
+105 ;TPF;IB*2*770v38;EBILL-5485
+106 IF $GET(IBPARENT)
KILL @VALMAR
if VALMBG=VALMLST
SET VALMBG=VALMBG-VALM("LINES")
DO PULLLIST^IBACCWL1(.IBDAYSMAX,.IBBILLER,.IBDIV,.IBSORT,0)
SET VALMBCK="R"
QUIT
+107 ;TPF;IB*2*770v38;EBILL-5485
IF '$TEST
SET IBICAMEFROMEE=1
SET VALMBCK="R"
QUIT
+108 ;
+109 SET VALMBCK="R"
+110 ;
+111 QUIT
+112 ;
SEL(IBDA,OPTION) ;EP -
+1 KILL IBDA,VALMY
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)),$SELECT($GET(OPTION)'="":OPTION,1:"S"))
+4 if '$DATA(VALMY)
QUIT
+5 ;
+6 SET IBDA("TOTAL")=0
+7 SET IBDA=0
+8 FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+9 SET IBDA(IBDA)=$GET(@VALMAR@(+IBDA,0))
+10 SET IBDA("TOTAL")=IBDA("TOTAL")+1
End DoDot:1
+11 SET IBDA=$ORDER(IBDA(""))
+12 ;
+13 QUIT
