IBACCWLUTIL4 ;EDE/TPF - ACC (Automated Community Care) Encounters utility APIs (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
;
NEWPROVMAIN ;EP - PROVIDER MAINTENCE - HAD TO MOVE BECAUSE OF SIZE FROM IBACCWLAIVIEW
;
N IBACCNEWNPI,DUOUT,DTOUT,DUROUT,NEWNPI,X,Y
;
;ARRAY HOLDING NEW PROV NPIs
S IBACCNEWNPI("CALLER")="PROVMAIN^IBACCWUTIL4" ;IS CALLER NEEDED? PERMISSION IN PROV. MAIN?
;
D FULL^VALM1
K IBNVPMIF ;NEWED AND SET IN NP^IBCEP6 TPF;EBILL-??? TESTING
;
D EN^IBCEP6 ;TAKES YOU TO [IBCE PROVIDER MAINT^Provider ID Maintenance
;
D FULL^VALM1
;
;B:$G(DUZ)=561 "S+"
;S IBACCNEWNPI("NEWNPI",1003004318)="" ;TPF;EBILL-9999;ISSUE #463
;S IBACCNEWNPI("NEWNPI",1003007311)=""
;S IBACCNEWNPI("NEWNPI",1003008533)=""
;S IBACCNEWNPI("NEWNPI",1417977760)=""
;S IBACCNEWNPI("NEWNPI",1003018086)=""
;S IBACCNEWNPI("NEWNPI",1003020116)=""
;
I '$D(IBACCNEWNPI("NEWNPI")) D Q
.W !!,"A NEW ENTRY WAS NOT DETECTED SO AN NPI UPDATE WILL NOT OCCUR",!
.N DIR
.S DIR(0)="E"
.D ^DIR
;
W !!,"The following NPIs were added to the VistA database."
W !
S NEWNPI=0
F S NEWNPI=$O(IBACCNEWNPI("NEWNPI",NEWNPI)) Q:NEWNPI="" D
.W !,NEWNPI
W !,""
W !,"Encounters requiring these NPIs will be re-submitted."
W !,"If an encounter successfully transmits it will be closed."
W !,"Active work list displays will be updated appropriately."
;
;ALLOW BACKGROUND TASK
;N ZTSK D TASKMAN(.ZTSK)
;Q:$G(ZTSK)
;
N DIR
W !
S DIR(0)="E"
D ^DIR
Q:$D(DUOUT)!$D(DUROUT)!$D(DTOUT)
;
D NPIUPDATE(.IBACCNEWNPI) ;CHECK "ANPI" X-REF AND PROCESS RESUBMISSIONS BASED ON NEW NPIs ENTERED IN PROV. MAIN. AND THOSE IN "ANPI"
;
W !!,"Re-submissions completed!"
;
N DIR
W !
S DIR(0)="E"
D ^DIR
;
Q
;
NPIUPDATE(IBACCNEWNPI) ;EP - RESUBMIT NPI IF USER ADDED AN NPI AND IT IS ALSO LISTED IN THE "ANPI" X-REF
NPIUPDATEQ ;EP - TASKMAN ENTRY POINT?
;
Q:'$D(IBACCNEWNPI) ;MAKE SURE TASK HAS AN ARRAY TO WORK WITH
;
N IBENCIFN,NEWNPI,NEWORDER,ORDERBYENC,RESUBMITTED
;
D ORDERBYENC(.ORDERBYENC,.IBACCNEWNPI)
;
S NEWNPI=""
F S NEWNPI=$O(IBACCNEWNPI("NEWNPI",NEWNPI)) Q:NEWNPI="" D
.I '$D(^IBA(364.9,"ANPI",NEWNPI)) W !!!,"New NPI "_NEWNPI_" was not found in Missing NPI error list - no encounters to resubmit." Q
.S IBENCIFN=0
.F S IBENCIFN=$O(^IBA(364.9,"ANPI",NEWNPI,IBENCIFN)) Q:'IBENCIFN D
..Q:$D(RESUBMITTED(IBENCIFN)) ;DO NOT RESUBMIT IEN ALREADY SUBMITTED. NO MATTER HOW MANY NPIS IN THE "ANPI" X-REF
..Q:(U_0_U_1_U)'[(U_$$GET1^DIQ(364.9,IBENCIFN_",",.16,"I")_U) ;PROCESS ONLY OPEN AND IN PROGRESS ENCOUNTERS
..D RESUBMIT(IBENCIFN,.ORDERBYENC,NEWNPI)
..S RESUBMITTED(IBENCIFN)=""
;
Q
;
ORDERBYENC(ORDERBYENC,IBACCNEWNPI) ;EP - GET REDORDER FOR USE IN PREV ACT, COMMENTS
;
N NPI,ENC,WL
S NPI=0
F S NPI=$O(^IBA(364.9,"ANPI",NPI)) Q:NPI="" D
.Q:'$D(IBACCNEWNPI("NEWNPI",NPI))
.S ENC=0
.F S ENC=$O(^IBA(364.9,"ANPI",NPI,ENC)) Q:ENC="" D
..Q:$$GET1^DIQ(364.9,ENC_",",3.01,"I")="" ;TPF;IB*2*770v44;EBILL-6009
..Q:$$GET1^DIQ(364.9,ENC_",",.16,"I")="" ;TPF;IB*2*770v44;EBILL-6009
..Q:$$GET1^DIQ(364.9,ENC_",",.16,"I")>1 ;QUIT IF CLOSED OR PURGED
..;
..S ORDERBYENC(ENC,NPI)=""
..S WL=$$GET1^DIQ(364.9,ENC_",",3.01,"I")
..S ORDERBYENC("WL",ENC,WL)=""
;
Q
;
RESUBMIT(IBENCIFN,ORDERBYENC,NEWNPI) ;EP - RESUBMIT
;
N ADDFDA,ADDIENS,ADDERR,BILLNUM,IBENCIENS,SUCCESS,X12CLAIM
;
S IBENCIENS=IBENCIFN_","
;GET PREVIOUS DATA BEFORE RESUBMIT
S (ASSIGNGRP,ASSIGNTOGRP,PREASSIGNTOGRP)=$$GET1^DIQ(364.9,IBENCIENS,3.01,"I")
;
S ADDIENS="+1,"_IBENCIFN_","
S ADDFDA(364.94,ADDIENS,.01)="NOW"
S ADDFDA(364.94,ADDIENS,.02)="`"_$G(DUZ)
;S ADDFDA(364.94,ADDIENS,.03)="`"_$G(ACTCODEIEN) ;THERE IS NO ACIVITY CODE FOR A NPI UPDATE
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) ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
.W !,$G(ADDERR("DIERR",1,"TEXT",1))
.N DIR,DIRUT,DUOUT,DTOUT
.D PAUSE^VALM1
;
S DA=ADDIENS(1)
S DA(1)=IBENCIFN
S DEFSTATUS="IN PROGRESS"
D EDITPREVACT(.DA,DEFSTATUS,.ASSIGNTOGRP,.ORDERBYENC) ;EDIT PREVIOUS ACTIVITY
;
S X12CLAIM=$$GET1^DIQ(364.9,IBENCIFN_",",.15)
S BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",2.02)
;
S SUCCESS=$$VAL^IBCE837ACCU(IBENCIFN) ;returns a 1 for success, 0 for failure. if failure, file 364.9 will have the reason(s)
W !!,"Submitting ",$S(BILLNUM'="":"Bill #: "_BILLNUM,1:"Encounter #: "_X12CLAIM)
W !,"New NPI entered "_$G(NEWNPI)
W:SUCCESS !,"Resubmission succeeded!" ;TPF;IB*2*770vPURPLE;EBILL-5700
;
D UPDATEWL(IBENCIFN,ASSIGNTOGRP,SUCCESS) ;UPDATE ENCOUNTER INDICATOR ON RESUBMIT WORKGROUP DISPLAYS
;
Q
;
;D UPDATEWL^IBACCWLUTIL4(28,1437191376,"RUR")
;UPDATEWL(IBENCIFN,NEWNPI,ASSIGNTOGRP,SUCCESS) ;EP - UPDATE ACTIVE WORK LISTS
UPDATEWL(IBENCIFN,ASSIGNTOGRP,SUCCESS) ;EP - UPDATE ACTIVE WORK LISTS
;
N ABORT,CNR,IBDAIEN,IBWLGRP,JOB,VALMDDF,WLFOUND
S ABORT=0
;
S IBWLGRP="IBACCWL"
S CNT=0
F S IBWLGRP=$O(^TMP(IBWLGRP)) Q:IBWLGRP=""!(IBWLGRP'[("IBACCWL")) D ;UPDATE ALL WRK GRPS WITH THIS ENCOUNTER
.Q:IBWLGRP[("EE") ;SKIP EE DISPLAYS
.S JOB=0
.F S JOB=$O(^TMP(IBWLGRP,JOB)) Q:'JOB D
..S IBDAIEN=$G(^TMP(IBWLGRP,JOB,"IEN3649",IBENCIFN))
..Q:IBDAIEN=""
..K ORDERBYENC("WL",IBENCIFN) ;ENCOUNTER IS NOT IN THIS WL ;TPF;IB*2*770vPURPLE;EBILL-5700
..D NPIVALMDDF(IBWLGRP,.ABORT,.NPIVALMDDF)
..Q:$G(ABORT)
..S CNT=CNT+1
..;UPDATE THE APPROPRIATE FIELDS IN WL
..I SUCCESS D SUCCESS(IBENCIFN,IBDAIEN,.NPIVALMDDF,CNT)
..E D NOTSUCCESS(IBENCIFN,IBDAIEN,.NPIVALMDDF,ASSIGNTOGRP,CNT)
I $D(ORDERBYENC("WL",IBENCIFN)) D NOTINWLDISP(IBENCIFN) K ORDERBYENC("WL",IBENCIFN) ;DISPLAY INFO IF NOT FOUND IN ANY WL
;
Q
;
NOTINWLDISP(IBENCIFN) ;EP -DISPLAY FOR THOSE NOT FOUD IN WL
;
N ASSIGNTOGRP,STATUS,BILLNUM
S BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"E")
I BILLNUM="" S BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",.15,"E")
S ASSIGNTOGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"I") ;TPF;IB*2&770v44;EBILL-5924
S STATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16,"E")
I STATUS'="CLOSED" W !,"Bill/Enc # "_$G(BILLNUM)_" has been assigned to "_$G(ASSIGNTOGRP)
W !,"Status is "_$G(STATUS)
;
Q
;
NPIVALMDDF(WLGRP,ABORT,NPIVALMDDF) ;EP - CREATE VALMDFF GIVEN WORK GROUP
;
N LISTIEN,LISTNAME
S LISTNAME="IBACC WL IBACC"_$P(WLGRP,"IBACCWL",2)
S LISTIEN=$O(^SD(409.61,"B",LISTNAME,""))
I LISTIEN="" W !!,"'"_LISTNAME_"' LIST TEMPLATE CAN NOT BE FOUND!!" S ABORT=1 Q
;
S NPIVALMDDF("VALMAR")=$TR($P($G(^SD(409.61,LISTIEN,"ARRAY")),",")," ")
;
S I=0 ;SET UP COLUMN DATA ARRAY
F S I=$O(^SD(409.61,LISTIEN,"COL",I)) Q:'I I $D(^(I,0)) S NPIVALMDDF($P(^(0),U))=^(0)
;
Q
;
NOTSUCCESS(IBENCIFN,IBDAIEN,VALMDDF,PREASSIGNTOGRP,CNT) ;EP - UPDATE DISPLAY FIELDS ONLY PERTINENT TO A FAILED RESUBMISSION
;
N BILLNUM,STATUS,LINENUM,POSTASSIGNGRP,STATUS,VALMAR
S VALMAR=$G(VALMDDF("VALMAR"))_","_JOB_")"
Q:VALMAR=""
;
S BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"E")
I BILLNUM="" S BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",.15,"E")
S STATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16,"E")
;
I $D(VALMDDF("BILLNUM")) D
.D FLDTEXT^VALM10(IBDAIEN,"BILLNUM",BILLNUM)
;
S POSTASSIGNGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"I")
;
D:$D(VALMDDF("INDICATOR")) FLDTEXT^VALM10(IBDAIEN,"INDICATOR","* ")
D:$D(VALMDDF("REASCODE")) FLDTEXT^VALM10(IBDAIEN,"REASCODE",$$REASCODE^IBACCWLUTIL1(IBENCIFN))
D:$D(VALMDDF("PREVACT")) FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
;
D:$D(VALMDDF("INDICATOR")) FLDTEXT^VALM10(IBDAIEN,"INDICATOR","# ")
W:$G(CNT)=1 !,"Bill/Enc # "_$G(BILLNUM)_" has been assigned to "_$G(POSTASSIGNGRP) ;TPF;IB*2*770vPURPLE;EBILL-5700
W:$G(CNT)=1 !,"Status is "_$G(STATUS)
S @VALMAR@(IBDAIEN,"UNAVAILABLE")="IT HAS BEEN ASSIGNED TO A DIFFERENT WORK GROUP!"
;
Q
;
SUCCESS(IBENCIFN,IBDAIEN,VALMDDF,CNT) ;EP - UPDATE DISPLAY FIELDS ONLY PERTINENT TO A SUCCSESSFUL RESUBMISSION
;
N STATUS,VALMAR
S VALMAR=$G(VALMDDF("VALMAR"))_","_JOB_")"
Q:VALMAR=""
;
;DISPLAY STATUS SHOULD BE CLOSED IF SUBMISSION SUCCEEDED
D:$D(VALMDDF("INDICATOR")) FLDTEXT^VALM10(IBDAIEN,"INDICATOR","C ")
D:$D(VALMDDF("PREVACT")) FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
S @VALMAR@(IBDAIEN,"UNAVAILABLE")="RECORD HAS BEEN SUCCESSFULLY TRANSMITTED! ON YOUR NEXT LOG IN YOU SHOULD NOT SEE THIS ENTRY"
;
Q
;
EDITPREVACT(DA,DEFSTATUS,ASSIGNTOGRP,ORDERBYENC) ;EP- EDIT PREVIOUS ACTIVITY
;
N COMMENT,DIE,ENC,ERROR,LINE,NPI,PREVACTIENS,PREVACTRET,RETURN
;
S ENC=DA(1)
S PREVACTIENS=$$IENS^DILF(.DA)
;
;SET STANDARD NPI UPDATE COMMENT
S COMMENT(1)=" "
S COMMENT(2)="This encounter was resubmitted because required NPIs"
S COMMENT(3)="were missing for auto-processing."
S COMMENT(4)=" "
S COMMENT(5)="The following NPIs were added using the"
S COMMENT(6)="PM Provider Maintenance Menu ACTION:"
S COMMENT(7)=" "
;
S NPI="" F LINE=8:1 S NPI=$O(ORDERBYENC(ENC,NPI)) Q:'NPI D
.S COMMENT(LINE)=" "_$G(NPI)
;
S COMMENT(LINE+1)=" "
S COMMENT(LINE+2)="See Reasons not autobilled for updated results."
;
K WPERR
D EDITPREVACT^IBACCWLUTIL(PREVACTIENS,.COMMENT,.WPERR)
;
I $D(WPERR) D
.W !!,"Problem adding comment to Encounter. Report to eBilling"
.W !,$G(WPERR("DIERR",1,"TEXT",1))
.N DIR
.S DIR(0)="E"
.D ^DIR
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLUTIL4 9699 printed May 25, 2026@12:10:17 Page 2
IBACCWLUTIL4 ;EDE/TPF - ACC (Automated Community Care) Encounters utility APIs (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 ;
+4 QUIT
+5 ;
NEWPROVMAIN ;EP - PROVIDER MAINTENCE - HAD TO MOVE BECAUSE OF SIZE FROM IBACCWLAIVIEW
+1 ;
+2 NEW IBACCNEWNPI,DUOUT,DTOUT,DUROUT,NEWNPI,X,Y
+3 ;
+4 ;ARRAY HOLDING NEW PROV NPIs
+5 ;IS CALLER NEEDED? PERMISSION IN PROV. MAIN?
SET IBACCNEWNPI("CALLER")="PROVMAIN^IBACCWUTIL4"
+6 ;
+7 DO FULL^VALM1
+8 ;NEWED AND SET IN NP^IBCEP6 TPF;EBILL-??? TESTING
KILL IBNVPMIF
+9 ;
+10 ;TAKES YOU TO [IBCE PROVIDER MAINT^Provider ID Maintenance
DO EN^IBCEP6
+11 ;
+12 DO FULL^VALM1
+13 ;
+14 ;B:$G(DUZ)=561 "S+"
+15 ;S IBACCNEWNPI("NEWNPI",1003004318)="" ;TPF;EBILL-9999;ISSUE #463
+16 ;S IBACCNEWNPI("NEWNPI",1003007311)=""
+17 ;S IBACCNEWNPI("NEWNPI",1003008533)=""
+18 ;S IBACCNEWNPI("NEWNPI",1417977760)=""
+19 ;S IBACCNEWNPI("NEWNPI",1003018086)=""
+20 ;S IBACCNEWNPI("NEWNPI",1003020116)=""
+21 ;
+22 IF '$DATA(IBACCNEWNPI("NEWNPI"))
Begin DoDot:1
+23 WRITE !!,"A NEW ENTRY WAS NOT DETECTED SO AN NPI UPDATE WILL NOT OCCUR",!
+24 NEW DIR
+25 SET DIR(0)="E"
+26 DO ^DIR
End DoDot:1
QUIT
+27 ;
+28 WRITE !!,"The following NPIs were added to the VistA database."
+29 WRITE !
+30 SET NEWNPI=0
+31 FOR
SET NEWNPI=$ORDER(IBACCNEWNPI("NEWNPI",NEWNPI))
if NEWNPI=""
QUIT
Begin DoDot:1
+32 WRITE !,NEWNPI
End DoDot:1
+33 WRITE !,""
+34 WRITE !,"Encounters requiring these NPIs will be re-submitted."
+35 WRITE !,"If an encounter successfully transmits it will be closed."
+36 WRITE !,"Active work list displays will be updated appropriately."
+37 ;
+38 ;ALLOW BACKGROUND TASK
+39 ;N ZTSK D TASKMAN(.ZTSK)
+40 ;Q:$G(ZTSK)
+41 ;
+42 NEW DIR
+43 WRITE !
+44 SET DIR(0)="E"
+45 DO ^DIR
+46 if $DATA(DUOUT)!$DATA(DUROUT)!$DATA(DTOUT)
QUIT
+47 ;
+48 ;CHECK "ANPI" X-REF AND PROCESS RESUBMISSIONS BASED ON NEW NPIs ENTERED IN PROV. MAIN. AND THOSE IN "ANPI"
DO NPIUPDATE(.IBACCNEWNPI)
+49 ;
+50 WRITE !!,"Re-submissions completed!"
+51 ;
+52 NEW DIR
+53 WRITE !
+54 SET DIR(0)="E"
+55 DO ^DIR
+56 ;
+57 QUIT
+58 ;
NPIUPDATE(IBACCNEWNPI) ;EP - RESUBMIT NPI IF USER ADDED AN NPI AND IT IS ALSO LISTED IN THE "ANPI" X-REF
NPIUPDATEQ ;EP - TASKMAN ENTRY POINT?
+1 ;
+2 ;MAKE SURE TASK HAS AN ARRAY TO WORK WITH
if '$DATA(IBACCNEWNPI)
QUIT
+3 ;
+4 NEW IBENCIFN,NEWNPI,NEWORDER,ORDERBYENC,RESUBMITTED
+5 ;
+6 DO ORDERBYENC(.ORDERBYENC,.IBACCNEWNPI)
+7 ;
+8 SET NEWNPI=""
+9 FOR
SET NEWNPI=$ORDER(IBACCNEWNPI("NEWNPI",NEWNPI))
if NEWNPI=""
QUIT
Begin DoDot:1
+10 IF '$DATA(^IBA(364.9,"ANPI",NEWNPI))
WRITE !!!,"New NPI "_NEWNPI_" was not found in Missing NPI error list - no encounters to resubmit."
QUIT
+11 SET IBENCIFN=0
+12 FOR
SET IBENCIFN=$ORDER(^IBA(364.9,"ANPI",NEWNPI,IBENCIFN))
if 'IBENCIFN
QUIT
Begin DoDot:2
+13 ;DO NOT RESUBMIT IEN ALREADY SUBMITTED. NO MATTER HOW MANY NPIS IN THE "ANPI" X-REF
if $DATA(RESUBMITTED(IBENCIFN))
QUIT
+14 ;PROCESS ONLY OPEN AND IN PROGRESS ENCOUNTERS
if (U_0_U_1_U)'[(U_$$GET1^DIQ(364.9,IBENCIFN_",",.16,"I")_U)
QUIT
+15 DO RESUBMIT(IBENCIFN,.ORDERBYENC,NEWNPI)
+16 SET RESUBMITTED(IBENCIFN)=""
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
+19 ;
ORDERBYENC(ORDERBYENC,IBACCNEWNPI) ;EP - GET REDORDER FOR USE IN PREV ACT, COMMENTS
+1 ;
+2 NEW NPI,ENC,WL
+3 SET NPI=0
+4 FOR
SET NPI=$ORDER(^IBA(364.9,"ANPI",NPI))
if NPI=""
QUIT
Begin DoDot:1
+5 if '$DATA(IBACCNEWNPI("NEWNPI",NPI))
QUIT
+6 SET ENC=0
+7 FOR
SET ENC=$ORDER(^IBA(364.9,"ANPI",NPI,ENC))
if ENC=""
QUIT
Begin DoDot:2
+8 ;TPF;IB*2*770v44;EBILL-6009
if $$GET1^DIQ(364.9,ENC_",",3.01,"I")=""
QUIT
+9 ;TPF;IB*2*770v44;EBILL-6009
if $$GET1^DIQ(364.9,ENC_",",.16,"I")=""
QUIT
+10 ;QUIT IF CLOSED OR PURGED
if $$GET1^DIQ(364.9,ENC_",",.16,"I")>1
QUIT
+11 ;
+12 SET ORDERBYENC(ENC,NPI)=""
+13 SET WL=$$GET1^DIQ(364.9,ENC_",",3.01,"I")
+14 SET ORDERBYENC("WL",ENC,WL)=""
End DoDot:2
End DoDot:1
+15 ;
+16 QUIT
+17 ;
RESUBMIT(IBENCIFN,ORDERBYENC,NEWNPI) ;EP - RESUBMIT
+1 ;
+2 NEW ADDFDA,ADDIENS,ADDERR,BILLNUM,IBENCIENS,SUCCESS,X12CLAIM
+3 ;
+4 SET IBENCIENS=IBENCIFN_","
+5 ;GET PREVIOUS DATA BEFORE RESUBMIT
+6 SET (ASSIGNGRP,ASSIGNTOGRP,PREASSIGNTOGRP)=$$GET1^DIQ(364.9,IBENCIENS,3.01,"I")
+7 ;
+8 SET ADDIENS="+1,"_IBENCIFN_","
+9 SET ADDFDA(364.94,ADDIENS,.01)="NOW"
+10 SET ADDFDA(364.94,ADDIENS,.02)="`"_$GET(DUZ)
+11 ;S ADDFDA(364.94,ADDIENS,.03)="`"_$G(ACTCODEIEN) ;THERE IS NO ACIVITY CODE FOR A NPI UPDATE
+12 SET ADDFDA(364.94,ADDIENS,.04)=$GET(ASSIGNGRP)
+13 SET ADDFDA(364.94,ADDIENS,.05)=$GET(ASSIGNTOGRP)
+14 ;
+15 DO UPDATE^DIE("ES","ADDFDA","ADDIENS","ADDERR")
+16 ;
+17 IF $DATA(ADDERR)
Begin DoDot:1
+18 ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
WRITE !!,"Problem adding Previous Activity multiple for Encounter ien: : "_$GET(IBENCIFN)
+19 WRITE !,$GET(ADDERR("DIERR",1,"TEXT",1))
+20 NEW DIR,DIRUT,DUOUT,DTOUT
+21 DO PAUSE^VALM1
End DoDot:1
QUIT
+22 ;
+23 SET DA=ADDIENS(1)
+24 SET DA(1)=IBENCIFN
+25 SET DEFSTATUS="IN PROGRESS"
+26 ;EDIT PREVIOUS ACTIVITY
DO EDITPREVACT(.DA,DEFSTATUS,.ASSIGNTOGRP,.ORDERBYENC)
+27 ;
+28 SET X12CLAIM=$$GET1^DIQ(364.9,IBENCIFN_",",.15)
+29 SET BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",2.02)
+30 ;
+31 ;returns a 1 for success, 0 for failure. if failure, file 364.9 will have the reason(s)
SET SUCCESS=$$VAL^IBCE837ACCU(IBENCIFN)
+32 WRITE !!,"Submitting ",$SELECT(BILLNUM'="":"Bill #: "_BILLNUM,1:"Encounter #: "_X12CLAIM)
+33 WRITE !,"New NPI entered "_$GET(NEWNPI)
+34 ;TPF;IB*2*770vPURPLE;EBILL-5700
if SUCCESS
WRITE !,"Resubmission succeeded!"
+35 ;
+36 ;UPDATE ENCOUNTER INDICATOR ON RESUBMIT WORKGROUP DISPLAYS
DO UPDATEWL(IBENCIFN,ASSIGNTOGRP,SUCCESS)
+37 ;
+38 QUIT
+39 ;
+40 ;D UPDATEWL^IBACCWLUTIL4(28,1437191376,"RUR")
+41 ;UPDATEWL(IBENCIFN,NEWNPI,ASSIGNTOGRP,SUCCESS) ;EP - UPDATE ACTIVE WORK LISTS
UPDATEWL(IBENCIFN,ASSIGNTOGRP,SUCCESS) ;EP - UPDATE ACTIVE WORK LISTS
+1 ;
+2 NEW ABORT,CNR,IBDAIEN,IBWLGRP,JOB,VALMDDF,WLFOUND
+3 SET ABORT=0
+4 ;
+5 SET IBWLGRP="IBACCWL"
+6 SET CNT=0
+7 ;UPDATE ALL WRK GRPS WITH THIS ENCOUNTER
FOR
SET IBWLGRP=$ORDER(^TMP(IBWLGRP))
if IBWLGRP=""!(IBWLGRP'[("IBACCWL"))
QUIT
Begin DoDot:1
+8 ;SKIP EE DISPLAYS
if IBWLGRP[("EE")
QUIT
+9 SET JOB=0
+10 FOR
SET JOB=$ORDER(^TMP(IBWLGRP,JOB))
if 'JOB
QUIT
Begin DoDot:2
+11 SET IBDAIEN=$GET(^TMP(IBWLGRP,JOB,"IEN3649",IBENCIFN))
+12 if IBDAIEN=""
QUIT
+13 ;ENCOUNTER IS NOT IN THIS WL ;TPF;IB*2*770vPURPLE;EBILL-5700
KILL ORDERBYENC("WL",IBENCIFN)
+14 DO NPIVALMDDF(IBWLGRP,.ABORT,.NPIVALMDDF)
+15 if $GET(ABORT)
QUIT
+16 SET CNT=CNT+1
+17 ;UPDATE THE APPROPRIATE FIELDS IN WL
+18 IF SUCCESS
DO SUCCESS(IBENCIFN,IBDAIEN,.NPIVALMDDF,CNT)
+19 IF '$TEST
DO NOTSUCCESS(IBENCIFN,IBDAIEN,.NPIVALMDDF,ASSIGNTOGRP,CNT)
End DoDot:2
End DoDot:1
+20 ;DISPLAY INFO IF NOT FOUND IN ANY WL
IF $DATA(ORDERBYENC("WL",IBENCIFN))
DO NOTINWLDISP(IBENCIFN)
KILL ORDERBYENC("WL",IBENCIFN)
+21 ;
+22 QUIT
+23 ;
NOTINWLDISP(IBENCIFN) ;EP -DISPLAY FOR THOSE NOT FOUD IN WL
+1 ;
+2 NEW ASSIGNTOGRP,STATUS,BILLNUM
+3 SET BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"E")
+4 IF BILLNUM=""
SET BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",.15,"E")
+5 ;TPF;IB*2&770v44;EBILL-5924
SET ASSIGNTOGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"I")
+6 SET STATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16,"E")
+7 IF STATUS'="CLOSED"
WRITE !,"Bill/Enc # "_$GET(BILLNUM)_" has been assigned to "_$GET(ASSIGNTOGRP)
+8 WRITE !,"Status is "_$GET(STATUS)
+9 ;
+10 QUIT
+11 ;
NPIVALMDDF(WLGRP,ABORT,NPIVALMDDF) ;EP - CREATE VALMDFF GIVEN WORK GROUP
+1 ;
+2 NEW LISTIEN,LISTNAME
+3 SET LISTNAME="IBACC WL IBACC"_$PIECE(WLGRP,"IBACCWL",2)
+4 SET LISTIEN=$ORDER(^SD(409.61,"B",LISTNAME,""))
+5 IF LISTIEN=""
WRITE !!,"'"_LISTNAME_"' LIST TEMPLATE CAN NOT BE FOUND!!"
SET ABORT=1
QUIT
+6 ;
+7 SET NPIVALMDDF("VALMAR")=$TRANSLATE($PIECE($GET(^SD(409.61,LISTIEN,"ARRAY")),",")," ")
+8 ;
+9 ;SET UP COLUMN DATA ARRAY
SET I=0
+10 FOR
SET I=$ORDER(^SD(409.61,LISTIEN,"COL",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET NPIVALMDDF($PIECE(^(0),U))=^(0)
+11 ;
+12 QUIT
+13 ;
NOTSUCCESS(IBENCIFN,IBDAIEN,VALMDDF,PREASSIGNTOGRP,CNT) ;EP - UPDATE DISPLAY FIELDS ONLY PERTINENT TO A FAILED RESUBMISSION
+1 ;
+2 NEW BILLNUM,STATUS,LINENUM,POSTASSIGNGRP,STATUS,VALMAR
+3 SET VALMAR=$GET(VALMDDF("VALMAR"))_","_JOB_")"
+4 if VALMAR=""
QUIT
+5 ;
+6 SET BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"E")
+7 IF BILLNUM=""
SET BILLNUM=$$GET1^DIQ(364.9,IBENCIFN_",",.15,"E")
+8 SET STATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16,"E")
+9 ;
+10 IF $DATA(VALMDDF("BILLNUM"))
Begin DoDot:1
+11 DO FLDTEXT^VALM10(IBDAIEN,"BILLNUM",BILLNUM)
End DoDot:1
+12 ;
+13 SET POSTASSIGNGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"I")
+14 ;
+15 if $DATA(VALMDDF("INDICATOR"))
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR","* ")
+16 if $DATA(VALMDDF("REASCODE"))
DO FLDTEXT^VALM10(IBDAIEN,"REASCODE",$$REASCODE^IBACCWLUTIL1(IBENCIFN))
+17 if $DATA(VALMDDF("PREVACT"))
DO FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
+18 ;
+19 if $DATA(VALMDDF("INDICATOR"))
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR","# ")
+20 ;TPF;IB*2*770vPURPLE;EBILL-5700
if $GET(CNT)=1
WRITE !,"Bill/Enc # "_$GET(BILLNUM)_" has been assigned to "_$GET(POSTASSIGNGRP)
+21 if $GET(CNT)=1
WRITE !,"Status is "_$GET(STATUS)
+22 SET @VALMAR@(IBDAIEN,"UNAVAILABLE")="IT HAS BEEN ASSIGNED TO A DIFFERENT WORK GROUP!"
+23 ;
+24 QUIT
+25 ;
SUCCESS(IBENCIFN,IBDAIEN,VALMDDF,CNT) ;EP - UPDATE DISPLAY FIELDS ONLY PERTINENT TO A SUCCSESSFUL RESUBMISSION
+1 ;
+2 NEW STATUS,VALMAR
+3 SET VALMAR=$GET(VALMDDF("VALMAR"))_","_JOB_")"
+4 if VALMAR=""
QUIT
+5 ;
+6 ;DISPLAY STATUS SHOULD BE CLOSED IF SUBMISSION SUCCEEDED
+7 if $DATA(VALMDDF("INDICATOR"))
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR","C ")
+8 if $DATA(VALMDDF("PREVACT"))
DO FLDTEXT^VALM10(IBDAIEN,"PREVACT",$$PREVACT^IBACCWLUTIL1(IBENCIFN))
+9 SET @VALMAR@(IBDAIEN,"UNAVAILABLE")="RECORD HAS BEEN SUCCESSFULLY TRANSMITTED! ON YOUR NEXT LOG IN YOU SHOULD NOT SEE THIS ENTRY"
+10 ;
+11 QUIT
+12 ;
EDITPREVACT(DA,DEFSTATUS,ASSIGNTOGRP,ORDERBYENC) ;EP- EDIT PREVIOUS ACTIVITY
+1 ;
+2 NEW COMMENT,DIE,ENC,ERROR,LINE,NPI,PREVACTIENS,PREVACTRET,RETURN
+3 ;
+4 SET ENC=DA(1)
+5 SET PREVACTIENS=$$IENS^DILF(.DA)
+6 ;
+7 ;SET STANDARD NPI UPDATE COMMENT
+8 SET COMMENT(1)=" "
+9 SET COMMENT(2)="This encounter was resubmitted because required NPIs"
+10 SET COMMENT(3)="were missing for auto-processing."
+11 SET COMMENT(4)=" "
+12 SET COMMENT(5)="The following NPIs were added using the"
+13 SET COMMENT(6)="PM Provider Maintenance Menu ACTION:"
+14 SET COMMENT(7)=" "
+15 ;
+16 SET NPI=""
FOR LINE=8:1
SET NPI=$ORDER(ORDERBYENC(ENC,NPI))
if 'NPI
QUIT
Begin DoDot:1
+17 SET COMMENT(LINE)=" "_$GET(NPI)
End DoDot:1
+18 ;
+19 SET COMMENT(LINE+1)=" "
+20 SET COMMENT(LINE+2)="See Reasons not autobilled for updated results."
+21 ;
+22 KILL WPERR
+23 DO EDITPREVACT^IBACCWLUTIL(PREVACTIENS,.COMMENT,.WPERR)
+24 ;
+25 IF $DATA(WPERR)
Begin DoDot:1
+26 WRITE !!,"Problem adding comment to Encounter. Report to eBilling"
+27 WRITE !,$GET(WPERR("DIERR",1,"TEXT",1))
+28 NEW DIR
+29 SET DIR(0)="E"
+30 DO ^DIR
End DoDot:1
+31 ;
+32 QUIT
