IBACCWLAIBILL ;EDE/TPF - ACC (Automated Community Care) Claims - Action Items related to actions on a Bill; 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.
;
;CHANGE ENTRY ACTION FOR PROTOCOL 'IBACC WL IBACCBILL EDIT'
;D EDIT^IBACCWLAIBILL1 ;TPF;IB*2*770v32;MOVED PER SAC SIZE LIMIT
;
Q
;
;CALLED BY PROTOCOL:
;IBACC WL IBACCBILL CANCEL
CANCEL ;EP - CANCEL ACC CLAIM
;
N DFN,IBCAN,IBENCIFN,IBIFN,IBBILL,IBNOASK
;
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
;
;I VALMAR[("IBACCWLEE") D
;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 cancelled."
. N DIR ;TPF;IB*2*770v47;EBILL-6042
. D PAUSE^VALM1
. S VALMBCK="R"
. Q
;
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
L +^DGCR(399,IBIFN):5 I '$T D Q
.W !!,"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 ;TPF;IB*2*770v33;EBILL-9999
.W !!,"File #364.9 record is Locked!! Please try again later." S VALMBCK="R"
.N DIR S DIR(0)="E" D ^DIR
;
D FULL^VALM1
;
;BASED ON OPTION [IB CANCEL BILL] **> Locked with IB AUTHORIZE
S IBNOASK=2
S Y=IBIFN
S IBCAN=1
D NOPTF^IBCC
L -^DGCR(399,IBIFN)
L -^IBA(364.9,IBENCIFN) ;TPF;IB*2*770v33;EBILL-9999
;JWS;8/18/25;EBILL-5421;CB action should update previous activity and close encounter
I $$GET1^DIQ(399,IBIFN_",",.13,"I")=7 D
. N NOTE
. S NOTE(1)="Claim has been cancelled through the ACC",NOTE(2)="worklist CB (Cancel Bill) action."
. D ADDPREVACT^IBACCWLUTIL(.RET,IBENCIFN,DUZ,1004,"BILL","BILL",.NOTE)
. Q
;
N DIR,DIRUT,DUOUT,DTOUT
D PAUSE^VALM1
S VALMBCK="R"
Q
;
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCBILL COMPLETE
BILLCOMP ;BILL COMPLETE
;
N DFN,IBENCIFN,IBIFN,IBBILL,IBVIEW,IBER,IBAC,TRANSMITTED,TRANSMITDATE
;
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
;
;I VALMAR[("IBACCWLEE") D
;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
;
D FULL^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!!"
.S DFN="NOT FOUND"
.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:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
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 ;TPF;IB*2*770v33;EBILL-9999
.W !!,"File #364.9 record is Locked!! Please try again later." S VALMBCK="R"
.N DIR S DIR(0)="E" D ^DIR
;
S IBVIEW=1
S IBER=1
S IBAC=1
D ^IBCB1
;
I $$TRANSMITTED^IBACCWLUTIL1(IBIFN) D Q
.L -^DGCR(399,IBIFN)
.L -^IBA(364.9,IBENCIFN) ;TPF;IB*2*770v33;EBILL-9999
.D UPDSTATUS^IBACCWLUTIL(IBENCIFN,"CLOSED")
.S TRANSMITDATE=$$FMTE^XLFDT($$GET1^DIQ(364,IBIFN_",",.14,"I"),"2ZD")
.K @VALMAR
.D PULLLIST^IBACCWL1(.IBDAYSMAX,.IBBILLER,.IBDIV,.IBSORT,0) ;RELOAD THE LIST
;
N DIR,DIRUT,DUOUT,DTOUT
D PAUSE^VALM1
S VALMBCK="R"
L -^DGCR(399,IBIFN)
L -^IBA(364.9,IBENCIFN) ;TPF;IB*2*770v33;EBILL-9999
Q
;
;CALLED BY PROTOCOL:
;IBACC WL IBACCCOMMON RESUBMIT
RESUBMIT ;EP - RESUBMIT
;
N BATCHITEM,BATCHCOMMENT,DFN,ESCAPE,IBBILL,IBIFN,IBENCIFN,SUCCESS,LASTONEPUBLISHED ;TPF;IB*2*770v32;EBILL-5519
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
I '$G(IBDA) N IBDA D SEL(.IBDA,"L")
;
I '$D(IBDA) S VALMBCK="R" Q
;
Q:$G(IBDA(IBDA))["----------------------"
;
D FULL^VALM1 ;TPF;IB*2*770v32;EBILL-5519
;
D AVAILABLECHK^IBACCWLUTIL1(.IBDA)
I '$D(IBDA) S VALMBCK="R" Q
I IBDA("TOTAL")=1,('$D(IBDA(IBDA))) S VALMBCK="R" Q
;
W !!,"PROCESSING RECORD(S): " N CNT,IEN S IEN=0 F CNT=1:1 S IEN=$O(IBDA(IEN)) Q:'IEN W $S(CNT'=1:",",1:"")_IEN
;
S LASTONEPUBLISHED=0
S ESCAPE=0
S IBDAIEN=""
F BATCHITEM=1:1 S IBDAIEN=$O(IBDA(IBDAIEN)) Q:'IBDAIEN D Q:$G(ESCAPE) ;TPF;IB*2*770v32;EBILL-5519
.Q:$G(IBDA(IBDAIEN))["----------------------"
.D RESUBMITLOOP(IBDAIEN,BATCHITEM,.BATCHCOMMENT,.SUCCESS,.LASTONEPUBLISHED) ;TPF;IB*2*770v34;EBILL-5519
;
;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
;
RESUBMITLOOP(IBDAIEN,BATCHITEM,BATCHCOMMENT,SUCCESS,LASTONEPUBLISHED) ;
;
N ADDFDA,ADDIENS,ADDERR,CURASSIGGRP,DFN,DIC,FROMSTATUS
N IBBILL,IBIFN,IBENCIFN,NOW,X,Y
;
D FULL^VALM1 ;TPF;IB*2*770v32;EBILL-5519
;
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@(IBDAIEN,"IEN399",1))
.S IBENCIFN=$G(@VALMAR@(IBDAIEN,"IEN3649",1))
;
S CURASSIGGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"I") ;TPF;IB*2*770v35;EBILL-5728
S FROMSTATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16) ;TPF;IB*2*770v35;EBILL-5728
;
I IBENCIFN S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND"
;
I $D(@VALMAR@(IBDAIEN,"UNAVAILABLE")) D Q
.W !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
.W !,$G(@VALMAR@(IBDAIEN,"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 ;TPF;IB*2*770v32;EBILL-5502
.W !!,"This encounter does not have a K#."
.W !
;
I $G(IBBILL)'="" D
.W !,"RESUBMITTING ACC CLAIM/BILL "_IBBILL
E W !,"RESUBMITTING X12 ENCOUNTER NUMBER: ",$P($G(^IBA(364.9,IBENCIFN,0)),U,15)
;
D FULL^VALM1
;
N X,Y,DIR
I BATCHITEM=1 D Q:$D(DUOUT)!$D(DTOUT)!($G(Y)'=1)!($G(ESCAPE))
.W !,"THIS WILL RESUBMIT THIS ENCOUNTER FOR AUTOBILL PROCESSING."
.S DIR(0)="Y"
.S DIR("A")="ARE YOU SURE YOU WISH TO CONTINUE"
.D ^DIR
.I $D(DUOUT)!$D(DTOUT)!($G(Y)'=1) S ESCAPE=1 ;TPF;IB*2*770v32;EBILL-5519
.S VALMBCK="R"
;
I $G(ACTCODEIEN),((U_23_U_26_U_27_U_508_U)[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U)) D
.N MODERR,MODFDA ;,IBENCIFN
.I 'IBENCIFN W !!,"CAN NOT COMPLETE RESUBMIT FROM RU ACTION!" H 2 Q
.S MODFDA(364.9,IBENCIFN_",",.31)=1
.D FILE^DIE("E","MODFDA","MODERR")
.I $D(MODERR) W !!,"ERROR ATTEMPTING TO UPDATE FIELD #.31 OF FILE #364.9" H 2 Q
;
S (ASSIGNGRP,ASSIGNTOGRP)=USERGROUP
S ADDIENS="+1,"_IBENCIFN_","
S ADDFDA(364.94,ADDIENS,.01)="NOW"
S ADDFDA(364.94,ADDIENS,.02)="`"_$G(DUZ)
I $G(ACTCODEIEN)="" D ;THIS IS A DIRECT RA SUBMISSION, SO SPECIFICALLY USE ACTIVITY CODE 54 IN THIS CASE ;MJL;EBILL-6209
.S ADDFDA(364.94,ADDIENS,.03)="`"_54
E D
.I $G(ACTCODEIEN),((U_23_U_26_U_27_U_508_U)[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U)) S ADDFDA(364.94,ADDIENS,.03)="`"_$G(ACTCODEIEN) ;TPF;IB*2*770v27;EBILL-5346 ;END NEW CODE ;MJL;EBILL-6209
S ADDFDA(364.94,ADDIENS,.04)=$G(ASSIGNGRP)
S ADDFDA(364.94,ADDIENS,.05)=$G(ASSIGNTOGRP)
;
D UPDATE^DIE("ES","ADDFDA","ADDIENS","ADDERR")
;
I $D(ADDERR) D Q
.W !!,"Problem adding Previous Activity multiple for Encounter ien: : "_$G(IBENCIFN)
.W !,$G(ADDERR("DIERR",1,"TEXT",1))
.S VALMBCK="R"
.N DIR,DIRUT,DUOUT,DTOUT
.D PAUSE^VALM1
;
S DA=ADDIENS(1)
S DA(1)=IBENCIFN
S DEFSTATUS="IN PROGRESS"
D FULL^VALM1 ;TPF;IB*2*770v32;EBILL-5502
D EDITPREVACT(.DA,.DEFSTATUS,.ASSIGNTOGRP,.ESCAPE,BATCHITEM,.BATCHCOMMENT) ;EDIT PREVIOUS ACTIVITY
;
D FULL^VALM1 ;TPF;IB*2*770v32;EBILL-5502
;
S SUCCESS=$$VAL^IBCE837ACCU(IBENCIFN) ;returns a 1 for success, 0 for failure. if failure, file 364.9 will have the reason(s)
;
I 'SUCCESS D
.N NEWASSIGNTOGRP
.S NEWASSIGNTOGRP=$$GET1^DIQ(364.9,IBENCIFN,3.01,"I")
.; check to see if RA'ing closed the encounter for displaying proper message ;WCJ;v39;purple;EBILL-5750;start changes
.I $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED" D
..W !!,$S($G(IBBILL)'="":"Bill "_IBBILL,1:"Encounter "_$P($G(^IBA(364.9,IBENCIFN,0)),U,15))_" has been CLOSED." ;WCJ;v39;purple;EBILL-5750
.I $$STATUS^IBACCWLUTIL1(IBENCIFN)'="CLOSED" D
..W !!,$S($G(IBBILL)'="":"Bill "_IBBILL,1:"Encounter "_$P($G(^IBA(364.9,IBENCIFN,0)),U,15))_" has been placed on the "_$$GET1^DIQ(364.9,IBENCIFN,3.01,"I")_" worklist."
..W !,"The record status has not been changed."
..W !,"But other fields may have changed." ;WCJ;v39;purple;EBILL-5750;end changes
.I $G(ACTCODEIEN),((U_23_U_26_U_27_U_508_U)[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U)) D
..N MODFDA,MODIENS,MODERR
..S MODIENS=ADDIENS(1)_","_IBENCIFN_","
..S MODFDA(364.94,MODIENS,.05)=$G(NEWASSIGNTOGRP)
..D FILE^DIE("E","MODFDA","MODERR")
..I $D(MODERR) W !,"There was a problem updating field .05 for Encounter "_$G(IBENCIFN) D
...N DIR,DUOUT,DTOUT,DIROUT
...S DIR(0)="E"
...D ^DIR
..D UPDAS2GRP^IBACCWLUTIL(IBENCIFN,NEWASSIGNTOGRP,0)
E D
.W !,"Resubmission was successful for "_$G(IBBILL) ;TPF;IB*2*770vPURPLE;EBILL-5700
N DIR
D PAUSE^VALM1
;
I $G(IBPARENT)=0 D EEPUBLISH^IBACCWLUTIL1(IBDAIEN,.IBFROMVALMDDF,SUCCESS,.LASTONEPUBLISHED) S VALMBCK="R" Q ;TPF;IB*2*770v38;EBILL-5485
;
I 'SUCCESS D
.D:$D(VALMDDF("REASCODE")) FLDTEXT^VALM10(IBDAIEN,"REASCODE",$$REASCODE^IBACCWLUTIL1(IBENCIFN))
.D:$D(VALMDDF("PREVACT")) FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
E D
.D:$D(VALMDDF("INDICATOR")) FLDTEXT^VALM10(IBDAIEN,"INDICATOR","# ")
.D:$D(VALMDDF("PREVACT")) FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
.D:$D(VALMDDF("ASSIGNEDGRP")) FLDTEXT^VALM10(IBDAIEN,"ASSIGNEDGRP",$$ASSIGNEDGRP^IBACCWLUTIL1(IBENCIFN))
.D:$D(VALMDDF("DATEASSNED")) FLDTEXT^VALM10(IBDAIEN,"DATEASSNED",$$DATEASSNED^IBACCWLUTIL1(IBENCIFN))
.S @VALMAR@(IBDAIEN,"UNAVAILABLE")="RECORD HAS BEEN REASSIGNED. ON YOUR NEXT LOG IN YOU MIGHT NOT SEE THIS ENTRY."
;
D:$G(PUBLISHINGON)&($G(ASSIGNTOGRP)'="") PUBLISH^IBACCWLUTIL(ASSIGNGRP,IBENCIFN,IBDAIEN,ASSIGNTOGRP,.VALMDDF,.PUBSUCCESS,IBDAIEN,.LASTONEPUBLISHED)
;
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
;
EDITPREVACT(DA,DEFSTATUS,ASSIGNTOGRP,ESCAPE,BATCHITEM,BATCHCOMMENT) ;EP- EDIT PREV. ACT.
N DIE,ERROR,PREVACTIENS,PREVACTRET,RETURN
;
S ESCAPE=0
;
I $G(DEFSTATUS)="" D EDITSTATUS^IBACCWLUTIL(DA(1),.DEFSTATUS)
E I $G(ACTCODEIEN),((U_23_U_26_U_27_U_508_U)'[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U)) D UPDSTATUS^IBACCWLUTIL(DA(1),.DEFSTATUS)
I DEFSTATUS'="CLOSED" D
.I $G(ASSIGNTOGRP)="" D EDITAS2GRP^IBACCWLUTIL(DA(1),.ASSIGNTOGRP)
.E I $G(ACTCODEIEN),((U_23_U_26_U_27_U_508_U)'[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U)) D UPDAS2GRP^IBACCWLUTIL(DA(1),.ASSIGNTOGRP,1)
;
S PREVACTIENS=$$IENS^DILF(.DA)
I BATCHITEM=1 D Q
.W !!,"Enter a comment so processing can fully be documented and the Reassignment"
.W !,"Group knows what has already been done or might be requested to do."
.W !,"This comment will be applied to "_$S($G(IBDA("TOTAL"))>1:"the entire batch.",1:"this encounter.") ;TPF;IB*2*770v38;EBILL-5825
.W !
.;
.S DIE="^IBA(364.9,"_DA(1)_",4,"
.S DR=""
.S DR=DR_"10"
.D ^DIE
.D GETS^DIQ(364.94,PREVACTIENS,"**","EIR","PREVACTRET","ERROR")
.M BATCHCOMMENT=PREVACTRET(364.94,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS")
.K BATCHCOMMENT("E")
.K BATCHCOMMENT("I")
;
I BATCHITEM>1,$D(BATCHCOMMENT) D Q
.K WPERR D EDITPREVACT^IBACCWLUTIL(PREVACTIENS,.BATCHCOMMENT,.WPERR)
.I $D(WPERR) D
..W !!,"Problem adding comment to Encounter. Report to eBilling"
..S VALMBCK="R"
..W !,$G(WPERR("DIERR",1,"TEXT",1))
..N DIR,DIRUT,DUOUT,DTOUT
..D PAUSE^VALM1
;
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLAIBILL 14984 printed May 25, 2026@12:09:48 Page 2
IBACCWLAIBILL ;EDE/TPF - ACC (Automated Community Care) Claims - Action Items related to actions on a Bill; 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
+8 ;EDIT ;EP - EDIT BILL.
+9 ;
+10 ;CHANGE ENTRY ACTION FOR PROTOCOL 'IBACC WL IBACCBILL EDIT'
+11 ;D EDIT^IBACCWLAIBILL1 ;TPF;IB*2*770v32;MOVED PER SAC SIZE LIMIT
+12 ;
+13 QUIT
+14 ;
+15 ;CALLED BY PROTOCOL:
+16 ;IBACC WL IBACCBILL CANCEL
CANCEL ;EP - CANCEL ACC CLAIM
+1 ;
+2 NEW DFN,IBCAN,IBENCIFN,IBIFN,IBBILL,IBNOASK
+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 ;I VALMAR[("IBACCWLEE") D
+13 ;IBPARENT=0 SHOWS IT IS A "CHILD" SCREEN!
+14 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+15 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+16 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+19 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+20 ;
+21 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+22 IF '$TEST
SET DFN="NOT FOUND"
+23 ;
+24 IF $DATA(@VALMAR@(IBDA,"UNAVAILABLE"))
Begin DoDot:1
+25 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+26 WRITE !,$GET(@VALMAR@(IBDA,"UNAVAILABLE"))
+27 SET VALMBCK="R"
+28 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+29 DO PAUSE^VALM1
End DoDot:1
QUIT
+30 ;
+31 IF $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED"
Begin DoDot:1
+32 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+33 WRITE !,"IT HAS BEEN CLOSED!"
+34 SET VALMBCK="R"
+35 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+36 DO PAUSE^VALM1
End DoDot:1
QUIT
+37 ;
+38 IF IBIFN'=""
Begin DoDot:1
+39 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+40 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+41 IF '$TEST
Begin DoDot:1
+42 WRITE !!,"This encounter does not have a K#."
+43 WRITE !,"THIS ACTION CANNOT BE EXECUTED!!"
+44 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+45 DO PAUSE^VALM1
+46 SET VALMBCK="R"
End DoDot:1
QUIT
+47 ;
+48 ;JWS;8/12/25;EBILL-5442;Users can edit a bill after CB action
+49 IF $$GET1^DIQ(399,IBIFN_",",.13,"I")'=1
Begin DoDot:1
+50 WRITE !,"VistA claim ",$$GET1^DIQ(399,IBIFN_",",.01)," with status of ",$$GET1^DIQ(399,IBIFN_",",.13)," can no longer be cancelled."
+51 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+52 DO PAUSE^VALM1
+53 SET VALMBCK="R"
+54 QUIT
End DoDot:1
QUIT
+55 ;
+56 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+57 ;
+58 LOCK +^DGCR(399,IBIFN):5
IF '$TEST
Begin DoDot:1
+59 WRITE !!,"Record is Locked!! Please try again later."
SET VALMBCK="R"
+60 NEW DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+61 ;
+62 ;TPF;IB*2*770v33;EBILL-9999
LOCK +^IBA(364.9,IBENCIFN):5
IF '$TEST
Begin DoDot:1
+63 WRITE !!,"File #364.9 record is Locked!! Please try again later."
SET VALMBCK="R"
+64 NEW DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+65 ;
+66 DO FULL^VALM1
+67 ;
+68 ;BASED ON OPTION [IB CANCEL BILL] **> Locked with IB AUTHORIZE
+69 SET IBNOASK=2
+70 SET Y=IBIFN
+71 SET IBCAN=1
+72 DO NOPTF^IBCC
+73 LOCK -^DGCR(399,IBIFN)
+74 ;TPF;IB*2*770v33;EBILL-9999
LOCK -^IBA(364.9,IBENCIFN)
+75 ;JWS;8/18/25;EBILL-5421;CB action should update previous activity and close encounter
+76 IF $$GET1^DIQ(399,IBIFN_",",.13,"I")=7
Begin DoDot:1
+77 NEW NOTE
+78 SET NOTE(1)="Claim has been cancelled through the ACC"
SET NOTE(2)="worklist CB (Cancel Bill) action."
+79 DO ADDPREVACT^IBACCWLUTIL(.RET,IBENCIFN,DUZ,1004,"BILL","BILL",.NOTE)
+80 QUIT
End DoDot:1
+81 ;
+82 NEW DIR,DIRUT,DUOUT,DTOUT
+83 DO PAUSE^VALM1
+84 SET VALMBCK="R"
+85 QUIT
+86 ;
+87 ;CALLED BY ACTION PROTOCOLS:
+88 ;IBACC WL IBACCBILL COMPLETE
BILLCOMP ;BILL COMPLETE
+1 ;
+2 NEW DFN,IBENCIFN,IBIFN,IBBILL,IBVIEW,IBER,IBAC,TRANSMITTED,TRANSMITDATE
+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 ;I VALMAR[("IBACCWLEE") D
+13 ;IBPARENT=0 SHOWS IT IS A "CHILD" SCREEN!
+14 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+15 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+16 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+19 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+20 ;
+21 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+22 IF '$TEST
SET DFN="NOT FOUND"
+23 ;
+24 IF $DATA(@VALMAR@(IBDA,"UNAVAILABLE"))
Begin DoDot:1
+25 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+26 WRITE !,$GET(@VALMAR@(IBDA,"UNAVAILABLE"))
+27 SET VALMBCK="R"
+28 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+29 DO PAUSE^VALM1
End DoDot:1
QUIT
+30 ;
+31 IF $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED"
Begin DoDot:1
+32 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+33 WRITE !,"IT HAS BEEN CLOSED!"
+34 SET VALMBCK="R"
+35 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+36 DO PAUSE^VALM1
End DoDot:1
QUIT
+37 ;
+38 DO FULL^VALM1
+39 IF IBIFN'=""
Begin DoDot:1
+40 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+41 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+42 IF '$TEST
Begin DoDot:1
+43 WRITE !!,"This encounter does not have a K#."
+44 WRITE !,"THIS ACTION CANNOT BE EXECUTED!!"
+45 SET DFN="NOT FOUND"
+46 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+47 DO PAUSE^VALM1
+48 SET VALMBCK="R"
End DoDot:1
QUIT
+49 ;
+50 ;JWS;8/12/25;EBILL-5442;Users can edit a bill after CB action
+51 IF $$GET1^DIQ(399,IBIFN_",",.13,"I")'=1
Begin DoDot:1
+52 WRITE !,"VistA claim ",$$GET1^DIQ(399,IBIFN_",",.01)," with status of ",$$GET1^DIQ(399,IBIFN_",",.13)," can no longer be edited."
+53 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+54 DO PAUSE^VALM1
+55 SET VALMBCK="R"
+56 QUIT
End DoDot:1
QUIT
+57 ;
+58 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+59 ;
+60 LOCK +^DGCR(399,IBIFN):5
IF '$TEST
Begin DoDot:1
+61 WRITE !!,"File #399 record is Locked!! Please try again later."
SET VALMBCK="R"
+62 NEW DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+63 ;
+64 ;TPF;IB*2*770v33;EBILL-9999
LOCK +^IBA(364.9,IBENCIFN):5
IF '$TEST
Begin DoDot:1
+65 WRITE !!,"File #364.9 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 SET IBVIEW=1
+69 SET IBER=1
+70 SET IBAC=1
+71 DO ^IBCB1
+72 ;
+73 IF $$TRANSMITTED^IBACCWLUTIL1(IBIFN)
Begin DoDot:1
+74 LOCK -^DGCR(399,IBIFN)
+75 ;TPF;IB*2*770v33;EBILL-9999
LOCK -^IBA(364.9,IBENCIFN)
+76 DO UPDSTATUS^IBACCWLUTIL(IBENCIFN,"CLOSED")
+77 SET TRANSMITDATE=$$FMTE^XLFDT($$GET1^DIQ(364,IBIFN_",",.14,"I"),"2ZD")
+78 KILL @VALMAR
+79 ;RELOAD THE LIST
DO PULLLIST^IBACCWL1(.IBDAYSMAX,.IBBILLER,.IBDIV,.IBSORT,0)
End DoDot:1
QUIT
+80 ;
+81 NEW DIR,DIRUT,DUOUT,DTOUT
+82 DO PAUSE^VALM1
+83 SET VALMBCK="R"
+84 LOCK -^DGCR(399,IBIFN)
+85 ;TPF;IB*2*770v33;EBILL-9999
LOCK -^IBA(364.9,IBENCIFN)
+86 QUIT
+87 ;
+88 ;CALLED BY PROTOCOL:
+89 ;IBACC WL IBACCCOMMON RESUBMIT
RESUBMIT ;EP - RESUBMIT
+1 ;
+2 ;TPF;IB*2*770v32;EBILL-5519
NEW BATCHITEM,BATCHCOMMENT,DFN,ESCAPE,IBBILL,IBIFN,IBENCIFN,SUCCESS,LASTONEPUBLISHED
+3 ;
+4 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+5 ;
+6 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA,"L")
+7 ;
+8 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+9 ;
+10 if $GET(IBDA(IBDA))["----------------------"
QUIT
+11 ;
+12 ;TPF;IB*2*770v32;EBILL-5519
DO FULL^VALM1
+13 ;
+14 DO AVAILABLECHK^IBACCWLUTIL1(.IBDA)
+15 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+16 IF IBDA("TOTAL")=1
IF ('$DATA(IBDA(IBDA)))
SET VALMBCK="R"
QUIT
+17 ;
+18 WRITE !!,"PROCESSING RECORD(S): "
NEW CNT,IEN
SET IEN=0
FOR CNT=1:1
SET IEN=$ORDER(IBDA(IEN))
if 'IEN
QUIT
WRITE $SELECT(CNT'=1:",",1:"")_IEN
+19 ;
+20 SET LASTONEPUBLISHED=0
+21 SET ESCAPE=0
+22 SET IBDAIEN=""
+23 ;TPF;IB*2*770v32;EBILL-5519
FOR BATCHITEM=1:1
SET IBDAIEN=$ORDER(IBDA(IBDAIEN))
if 'IBDAIEN
QUIT
Begin DoDot:1
+24 if $GET(IBDA(IBDAIEN))["----------------------"
QUIT
+25 ;TPF;IB*2*770v34;EBILL-5519
DO RESUBMITLOOP(IBDAIEN,BATCHITEM,.BATCHCOMMENT,.SUCCESS,.LASTONEPUBLISHED)
End DoDot:1
if $GET(ESCAPE)
QUIT
+26 ;
+27 ;TPF;IB*2*770v38;EBILL-5485
+28 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
+29 ;TPF;IB*2*770v38;EBILL-5485
IF '$TEST
SET IBICAMEFROMEE=1
SET VALMBCK="R"
QUIT
+30 ;
+31 SET VALMBCK="R"
+32 ;
+33 QUIT
+34 ;
RESUBMITLOOP(IBDAIEN,BATCHITEM,BATCHCOMMENT,SUCCESS,LASTONEPUBLISHED) ;
+1 ;
+2 NEW ADDFDA,ADDIENS,ADDERR,CURASSIGGRP,DFN,DIC,FROMSTATUS
+3 NEW IBBILL,IBIFN,IBENCIFN,NOW,X,Y
+4 ;
+5 ;TPF;IB*2*770v32;EBILL-5519
DO FULL^VALM1
+6 ;
+7 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+8 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+9 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET IBIFN=$GET(@VALMAR@(IBDAIEN,"IEN399",1))
+12 SET IBENCIFN=$GET(@VALMAR@(IBDAIEN,"IEN3649",1))
End DoDot:1
+13 ;
+14 ;TPF;IB*2*770v35;EBILL-5728
SET CURASSIGGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"I")
+15 ;TPF;IB*2*770v35;EBILL-5728
SET FROMSTATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16)
+16 ;
+17 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+18 IF '$TEST
SET DFN="NOT FOUND"
+19 ;
+20 IF $DATA(@VALMAR@(IBDAIEN,"UNAVAILABLE"))
Begin DoDot:1
+21 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+22 WRITE !,$GET(@VALMAR@(IBDAIEN,"UNAVAILABLE"))
+23 SET VALMBCK="R"
+24 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+25 DO PAUSE^VALM1
End DoDot:1
QUIT
+26 ;
+27 IF $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED"
Begin DoDot:1
+28 WRITE !,"THIS RECORD IS NO LONGER AVAILABLE BECAUSE "
+29 WRITE !,"IT HAS BEEN CLOSED!"
+30 SET VALMBCK="R"
+31 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+32 DO PAUSE^VALM1
End DoDot:1
QUIT
+33 ;
+34 IF IBIFN'=""
Begin DoDot:1
+35 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+36 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+37 ;TPF;IB*2*770v32;EBILL-5502
IF '$TEST
Begin DoDot:1
+38 WRITE !!,"This encounter does not have a K#."
+39 WRITE !
End DoDot:1
+40 ;
+41 IF $GET(IBBILL)'=""
Begin DoDot:1
+42 WRITE !,"RESUBMITTING ACC CLAIM/BILL "_IBBILL
End DoDot:1
+43 IF '$TEST
WRITE !,"RESUBMITTING X12 ENCOUNTER NUMBER: ",$PIECE($GET(^IBA(364.9,IBENCIFN,0)),U,15)
+44 ;
+45 DO FULL^VALM1
+46 ;
+47 NEW X,Y,DIR
+48 IF BATCHITEM=1
Begin DoDot:1
+49 WRITE !,"THIS WILL RESUBMIT THIS ENCOUNTER FOR AUTOBILL PROCESSING."
+50 SET DIR(0)="Y"
+51 SET DIR("A")="ARE YOU SURE YOU WISH TO CONTINUE"
+52 DO ^DIR
+53 ;TPF;IB*2*770v32;EBILL-5519
IF $DATA(DUOUT)!$DATA(DTOUT)!($GET(Y)'=1)
SET ESCAPE=1
+54 SET VALMBCK="R"
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)!($GET(Y)'=1)!($GET(ESCAPE))
QUIT
+55 ;
+56 IF $GET(ACTCODEIEN)
IF ((U_23_U_26_U_27_U_508_U)[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U))
Begin DoDot:1
+57 ;,IBENCIFN
NEW MODERR,MODFDA
+58 IF 'IBENCIFN
WRITE !!,"CAN NOT COMPLETE RESUBMIT FROM RU ACTION!"
HANG 2
QUIT
+59 SET MODFDA(364.9,IBENCIFN_",",.31)=1
+60 DO FILE^DIE("E","MODFDA","MODERR")
+61 IF $DATA(MODERR)
WRITE !!,"ERROR ATTEMPTING TO UPDATE FIELD #.31 OF FILE #364.9"
HANG 2
QUIT
End DoDot:1
+62 ;
+63 SET (ASSIGNGRP,ASSIGNTOGRP)=USERGROUP
+64 SET ADDIENS="+1,"_IBENCIFN_","
+65 SET ADDFDA(364.94,ADDIENS,.01)="NOW"
+66 SET ADDFDA(364.94,ADDIENS,.02)="`"_$GET(DUZ)
+67 ;THIS IS A DIRECT RA SUBMISSION, SO SPECIFICALLY USE ACTIVITY CODE 54 IN THIS CASE ;MJL;EBILL-6209
IF $GET(ACTCODEIEN)=""
Begin DoDot:1
+68 SET ADDFDA(364.94,ADDIENS,.03)="`"_54
End DoDot:1
+69 IF '$TEST
Begin DoDot:1
+70 ;TPF;IB*2*770v27;EBILL-5346 ;END NEW CODE ;MJL;EBILL-6209
IF $GET(ACTCODEIEN)
IF ((U_23_U_26_U_27_U_508_U)[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U))
SET ADDFDA(364.94,ADDIENS,.03)="`"_$GET(ACTCODEIEN)
End DoDot:1
+71 SET ADDFDA(364.94,ADDIENS,.04)=$GET(ASSIGNGRP)
+72 SET ADDFDA(364.94,ADDIENS,.05)=$GET(ASSIGNTOGRP)
+73 ;
+74 DO UPDATE^DIE("ES","ADDFDA","ADDIENS","ADDERR")
+75 ;
+76 IF $DATA(ADDERR)
Begin DoDot:1
+77 WRITE !!,"Problem adding Previous Activity multiple for Encounter ien: : "_$GET(IBENCIFN)
+78 WRITE !,$GET(ADDERR("DIERR",1,"TEXT",1))
+79 SET VALMBCK="R"
+80 NEW DIR,DIRUT,DUOUT,DTOUT
+81 DO PAUSE^VALM1
End DoDot:1
QUIT
+82 ;
+83 SET DA=ADDIENS(1)
+84 SET DA(1)=IBENCIFN
+85 SET DEFSTATUS="IN PROGRESS"
+86 ;TPF;IB*2*770v32;EBILL-5502
DO FULL^VALM1
+87 ;EDIT PREVIOUS ACTIVITY
DO EDITPREVACT(.DA,.DEFSTATUS,.ASSIGNTOGRP,.ESCAPE,BATCHITEM,.BATCHCOMMENT)
+88 ;
+89 ;TPF;IB*2*770v32;EBILL-5502
DO FULL^VALM1
+90 ;
+91 ;returns a 1 for success, 0 for failure. if failure, file 364.9 will have the reason(s)
SET SUCCESS=$$VAL^IBCE837ACCU(IBENCIFN)
+92 ;
+93 IF 'SUCCESS
Begin DoDot:1
+94 NEW NEWASSIGNTOGRP
+95 SET NEWASSIGNTOGRP=$$GET1^DIQ(364.9,IBENCIFN,3.01,"I")
+96 ; check to see if RA'ing closed the encounter for displaying proper message ;WCJ;v39;purple;EBILL-5750;start changes
+97 IF $$STATUS^IBACCWLUTIL1(IBENCIFN)="CLOSED"
Begin DoDot:2
+98 ;WCJ;v39;purple;EBILL-5750
WRITE !!,$SELECT($GET(IBBILL)'="":"Bill "_IBBILL,1:"Encounter "_$PIECE($GET(^IBA(364.9,IBENCIFN,0)),U,15))_" has been CLOSED."
End DoDot:2
+99 IF $$STATUS^IBACCWLUTIL1(IBENCIFN)'="CLOSED"
Begin DoDot:2
+100 WRITE !!,$SELECT($GET(IBBILL)'="":"Bill "_IBBILL,1:"Encounter "_$PIECE($GET(^IBA(364.9,IBENCIFN,0)),U,15))_" has been placed on the "_$$GET1^DIQ(364.9,IBENCIFN,3.01,"I")_" worklist."
+101 WRITE !,"The record status has not been changed."
+102 ;WCJ;v39;purple;EBILL-5750;end changes
WRITE !,"But other fields may have changed."
End DoDot:2
+103 IF $GET(ACTCODEIEN)
IF ((U_23_U_26_U_27_U_508_U)[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U))
Begin DoDot:2
+104 NEW MODFDA,MODIENS,MODERR
+105 SET MODIENS=ADDIENS(1)_","_IBENCIFN_","
+106 SET MODFDA(364.94,MODIENS,.05)=$GET(NEWASSIGNTOGRP)
+107 DO FILE^DIE("E","MODFDA","MODERR")
+108 IF $DATA(MODERR)
WRITE !,"There was a problem updating field .05 for Encounter "_$GET(IBENCIFN)
Begin DoDot:3
+109 NEW DIR,DUOUT,DTOUT,DIROUT
+110 SET DIR(0)="E"
+111 DO ^DIR
End DoDot:3
+112 DO UPDAS2GRP^IBACCWLUTIL(IBENCIFN,NEWASSIGNTOGRP,0)
End DoDot:2
End DoDot:1
+113 IF '$TEST
Begin DoDot:1
+114 ;TPF;IB*2*770vPURPLE;EBILL-5700
WRITE !,"Resubmission was successful for "_$GET(IBBILL)
End DoDot:1
+115 NEW DIR
+116 DO PAUSE^VALM1
+117 ;
+118 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
DO EEPUBLISH^IBACCWLUTIL1(IBDAIEN,.IBFROMVALMDDF,SUCCESS,.LASTONEPUBLISHED)
SET VALMBCK="R"
QUIT
+119 ;
+120 IF 'SUCCESS
Begin DoDot:1
+121 if $DATA(VALMDDF("REASCODE"))
DO FLDTEXT^VALM10(IBDAIEN,"REASCODE",$$REASCODE^IBACCWLUTIL1(IBENCIFN))
+122 if $DATA(VALMDDF("PREVACT"))
DO FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
End DoDot:1
+123 IF '$TEST
Begin DoDot:1
+124 if $DATA(VALMDDF("INDICATOR"))
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR","# ")
+125 if $DATA(VALMDDF("PREVACT"))
DO FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
+126 if $DATA(VALMDDF("ASSIGNEDGRP"))
DO FLDTEXT^VALM10(IBDAIEN,"ASSIGNEDGRP",$$ASSIGNEDGRP^IBACCWLUTIL1(IBENCIFN))
+127 if $DATA(VALMDDF("DATEASSNED"))
DO FLDTEXT^VALM10(IBDAIEN,"DATEASSNED",$$DATEASSNED^IBACCWLUTIL1(IBENCIFN))
+128 SET @VALMAR@(IBDAIEN,"UNAVAILABLE")="RECORD HAS BEEN REASSIGNED. ON YOUR NEXT LOG IN YOU MIGHT NOT SEE THIS ENTRY."
End DoDot:1
+129 ;
+130 if $GET(PUBLISHINGON)&($GET(ASSIGNTOGRP)'="")
DO PUBLISH^IBACCWLUTIL(ASSIGNGRP,IBENCIFN,IBDAIEN,ASSIGNTOGRP,.VALMDDF,.PUBSUCCESS,IBDAIEN,.LASTONEPUBLISHED)
+131 ;
+132 SET VALMBCK="R"
+133 QUIT
+134 ;
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
+14 ;
EDITPREVACT(DA,DEFSTATUS,ASSIGNTOGRP,ESCAPE,BATCHITEM,BATCHCOMMENT) ;EP- EDIT PREV. ACT.
+1 NEW DIE,ERROR,PREVACTIENS,PREVACTRET,RETURN
+2 ;
+3 SET ESCAPE=0
+4 ;
+5 IF $GET(DEFSTATUS)=""
DO EDITSTATUS^IBACCWLUTIL(DA(1),.DEFSTATUS)
+6 IF '$TEST
IF $GET(ACTCODEIEN)
IF ((U_23_U_26_U_27_U_508_U)'[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U))
DO UPDSTATUS^IBACCWLUTIL(DA(1),.DEFSTATUS)
+7 IF DEFSTATUS'="CLOSED"
Begin DoDot:1
+8 IF $GET(ASSIGNTOGRP)=""
DO EDITAS2GRP^IBACCWLUTIL(DA(1),.ASSIGNTOGRP)
+9 IF '$TEST
IF $GET(ACTCODEIEN)
IF ((U_23_U_26_U_27_U_508_U)'[(U_$$GET1^DIQ(364.92,ACTCODEIEN_",",.01)_U))
DO UPDAS2GRP^IBACCWLUTIL(DA(1),.ASSIGNTOGRP,1)
End DoDot:1
+10 ;
+11 SET PREVACTIENS=$$IENS^DILF(.DA)
+12 IF BATCHITEM=1
Begin DoDot:1
+13 WRITE !!,"Enter a comment so processing can fully be documented and the Reassignment"
+14 WRITE !,"Group knows what has already been done or might be requested to do."
+15 ;TPF;IB*2*770v38;EBILL-5825
WRITE !,"This comment will be applied to "_$SELECT($GET(IBDA("TOTAL"))>1:"the entire batch.",1:"this encounter.")
+16 WRITE !
+17 ;
+18 SET DIE="^IBA(364.9,"_DA(1)_",4,"
+19 SET DR=""
+20 SET DR=DR_"10"
+21 DO ^DIE
+22 DO GETS^DIQ(364.94,PREVACTIENS,"**","EIR","PREVACTRET","ERROR")
+23 MERGE BATCHCOMMENT=PREVACTRET(364.94,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS")
+24 KILL BATCHCOMMENT("E")
+25 KILL BATCHCOMMENT("I")
End DoDot:1
QUIT
+26 ;
+27 IF BATCHITEM>1
IF $DATA(BATCHCOMMENT)
Begin DoDot:1
+28 KILL WPERR
DO EDITPREVACT^IBACCWLUTIL(PREVACTIENS,.BATCHCOMMENT,.WPERR)
+29 IF $DATA(WPERR)
Begin DoDot:2
+30 WRITE !!,"Problem adding comment to Encounter. Report to eBilling"
+31 SET VALMBCK="R"
+32 WRITE !,$GET(WPERR("DIERR",1,"TEXT",1))
+33 NEW DIR,DIRUT,DUOUT,DTOUT
+34 DO PAUSE^VALM1
End DoDot:2
End DoDot:1
QUIT
+35 ;
+36 SET VALMBCK="R"
+37 QUIT
