IBACCWLAIVIEW ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Items related to Viewing Bill or Encounter data ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;D VIEWSERCON^IBACCWLAI
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCCOMMON VIEW SERV CONNECTED
VIEWSERCON(IBDA) ;EP - VIEW SERVICE CONNECTED DATA
N CNT,DFN,GREF,IBBILL,IBDATE,IBIFN,IBNAME,IBENCIFN,IBCLELIG
;
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
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,'$G(DFN) S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND"
;
;TPF;IB*2*770v12;BEGIN EBILL-5131
I IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E W !!,"This encounter does not have a K#."
;
I '$G(DFN) D Q
.W !,"This encounter does not have a Patient record in VistA."
.W !,"THIS ACTION CANNOT BE EXECUTED!!"
.S DFN="NOT FOUND"
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
.S VALMBCK="R"
;TPF;IB*2*770v25;BEGIN EBILL-5131
;
W:$G(IBBILL)'="" !,"ACC ENCOUNTER/CLAIM "_IBBILL_" SELECTED" H 2
W:$G(DFN) !,"PATIENT FOUND: ",$P($G(^DPT(DFN,0)),U)
;
D EN^IBACCWLVS(DFN)
S VALMBCK="R"
;
Q
;
;D VIEWENCOUNTER^IBACCWLAI Gives user a view only screen that displays Encounter (#364.9) displayed on the Worklist
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCCOMMON VIEW ENCOUNTER
VIEWENCOUNTER ;EP - VIEW READABLE ACC ENCOUNTER. ISN'T THIS IN EE?
N DFN,IBBILL,IBENCIFN,IBIFN,IBENCIEN
N STOP ;TPF;IB*2*770v53;EBILL-6203
;
;CHECK TO SEE IF USER ALREADY HAS INSTANTIATED VE
;TPF;IB*2*770v38;EBILL-5485
;BEGIN;TPF;BEGIN;IB*2*770v53;EBILL-6262
I $G(SESSIONKEY)'="IBACCBILL" I $D(^TMP("IBACCWLVE",$J)) S VALMBCK="R" Q
;
I $G(SESSIONKEY)="IBACCBILL" D Q:$G(STOP)
.I ($G(IBREGVE)=1),$D(^TMP("IBACCWLVE",$J)) S VALMBCK="R" S STOP=1 Q
.I ($G(IBREGVE)=0),$D(^TMP("IBACCWLBILLVE",$J)) S VALMBCK="R" S STOP=1 Q
;END;TPF;BEGIN;IB*2*770v53;EBILL-6262
;
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 $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"
;
D FULL^VALM1
;
;RUR GETS VE PLUS ALL ACTIONS THEY HAVE ON EE
;WE COULD SPLIT THE FLOW HERE FOR TWO DIFFERENT VEs FOR RUR AND ALL OTHERS.
;OR SPLIT IT IN D EN^IBACCWLVE AND CALL A DIFFERENT LIST TEMPLATE THERE?
;I VALMAR[("IBACCWLRUR")!($G(IBFROMVALMDDF(1,"NAME"))[("RUR")) D EN^IBACCWLVERUR(.IBDA,.IBFROMVALMDDF) S VALMBCK="R" Q ;TPF;IB*2*770v38;EBILL-5485
;
;BEGIN TPF;IB*2*770v38;EBILL-5485 ADDED BECAUSE VE IS ACCESSBLE FROM BOTH PARENT WL AND EE
;M IBFROMVALMDDF=VALMDDF ;PASS THE COLUMN SPECS AND ORIGINATING DATA ARRAY FOR UPDATING WHEN ACTION DONE IN EE
;M IBFROMVALMDDF("HDR")=VALMHDR ;TPF;IB*2*770v48;EBILL-6100 NOT USED
;S IBFROMVALMDDF(1,"NAME")=$G(NAME)
;S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
I $G(IBPARENT) D ;TPF;IB*2*770v49;EBILL-6100 THE PARENT COL DEFINITION SETS SHOULD ONLY OCCUR IF COMING IN FROM THE PARENT NOT A CHILD SCREEN
.M IBFROMVALMDDF=VALMDDF
.S IBFROMVALMDDF(1,"NAME")=$G(NAME)
.S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
M DETRETURN=ENCRETURN(IBDA)
S PREVVALMAR=$P($NA(@VALMAR),")")_")"
;END TPF;IB*2*770v38;EBILL-5485
;
;TPF;IB*2*770v48;EBILL-6100 MOVED FROM ABOVE IBFROMVALMDDF SETTING
I VALMAR[("IBACCWLRUR")!($G(IBFROMVALMDDF(1,"NAME"))[("RUR")) D EN^IBACCWLVERUR(.IBDA,.IBFROMVALMDDF) S VALMBCK="R" Q ;TPF;IB*2*770v38;EBILL-5485
;
I $G(IBREGVE)'=1,($G(SESSIONKEY)="IBACCBILL") D EN^IBACCWLBILLVE S VALMBCK="R" Q ;TPF;IB*2*770v53;EBILL-6203
;
;ALL OTHER WORKGROUPS USE THIS CALL FOR VIEW RAW X12 ENCOUNTER
D EN^IBACCWLVE
;
S IBICAMEFROMEE=1
;S IBACCWLBILLVELEV=1 ;TPF;IB*2*770v53;EBILL-6203;TPF;IB*2*770v62;EBILL-6615
S VALMBCK="R"
Q
;
;D REVSTATUS^IBACCWLAI
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCCOMMON REVIEW STATUS
REVSTATUS(IBDA) ;EP - REVIEW/EDIT ACC CLAIM STATUS
N BATCHITEM,BATCHSTATUS,BATCHCOMMENT,CURASSIGGRP,DA,DIE,DR,IBDAIEN
;
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
;
I $G(IBDA(IBDA))["----------------------",'$O(IBDA(IBDA)) S VALMBCK="R" Q
;
;CHECK SELECTED RECORDS TO SEE IF THEY HAVE BEEN REASSIGNED. IF IN THE "UNAVAILABLE STATUS' REMOVE FROM BATCH
D AVAILABLECHK^IBACCWLUTIL1(.IBDA)
I '$D(IBDA) S VALMBCK="R" Q
I IBDA("TOTAL")=1,('$D(IBDA(IBDA))) S VALMBCK="R" Q ;TPF;IB*2*770v22;BEGIN EBILL-4920 CORRECTION TO ERROR RESOLUTION FOUND DURING EBILL-4055
;
I IBDA("TOTAL")>1 S BATCHSTATUS=$$ASKSTATUS^IBACCWLUTIL1(1) I BATCHSTATUS=0 S VALMBCK="R" Q ;GET STATUS THE USER WISHES TO APPLY TO THE BATCH. 1=REQUIRED
;
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 IBDAIEN=""
F BATCHITEM=1:1 S IBDAIEN=$O(IBDA(IBDAIEN)) Q:'IBDAIEN D
.Q:$G(IBDA(IBDAIEN))["----------------------"
.D REVSTATUSLOOP(.IBDAIEN,BATCHITEM,.BATCHCOMMENT,$G(BATCHSTATUS))
;
S VALMBCK="R" ;TPF;IB*2*770v10;EBILL-4490
;
Q
;
REVSTATUSLOOP(IBDAIEN,BATCHITEM,BATCHCOMMENT,BATCHSTATUS) ;EP - LOOP REVSTATUS
;
N ADDERR,ADDIENS,ADDFDA,ADDERR,CURASSIGGRP,CURINDICATOR,FROMSTATUS,TOSTATUS,IBIFN,IBENCIEN,DFN,IBBILL
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
W !!,"PROCESSING RECORD: ",$G(IBDAIEN)
;
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))
;
I IBENCIFN S DFN=$P($G(^IBA(364.9,IBENCIFN,2)),U)
E S DFN="NOT FOUND"
;
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
.W !!,"This encounter does not have a K#."
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
D FULL^VALM1
S CURASSIGGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01)
S FROMSTATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16)
;
S CURASSIGGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"")
W !,"CURRENT ASSIGNED TO GROUP: "_CURASSIGGRP
;
W !,"CURRENT STATUS "_$G(FROMSTATUS) ;_" TO "_$G(TOSTATUS)
I IBDA("TOTAL")>1 D UPDSTATUS^IBACCWLUTIL(IBENCIFN,BATCHSTATUS)
;
I IBDA("TOTAL")=1 D
.D EDITSTATUS^IBACCWLUTIL(IBENCIFN,FROMSTATUS,0)
;
S TOSTATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16)
I IBDA("TOTAL")=1,(FROMSTATUS=TOSTATUS) S VALMBCK="R" Q ;NO NEED FOR AN AUDIT ENTRY IN PREVIOUS ACTIVITY IF NO CHANGE IN STATUS
;
I IBDA("TOTAL")>1,(FROMSTATUS=BATCHSTATUS) S VALMBCK="R" Q ;EBILL-9999 no change in STATUS creates PREV ACT - should not
;
;UPDATE THIS USER'S SCREEN LIST
M IBDAIEN(IBDAIEN)=IBDA(IBDAIEN)
;
;I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
I $G(IBPARENT)=1 D ;TPF;IB*2*770v38;EBILL-6087
.S CURINDICATOR=$TR($$GETFLD^IBACCWLUTIL(VALMDDF("INDICATOR"),.IBDAIEN)," ") ;GET THE CURRENT VALUE IN THE FIELD.
.D:$D(VALMDDF("INDICATOR"))&(TOSTATUS="IN PROGRESS") FLDTEXT^VALM10(IBDAIEN,"INDICATOR",CURINDICATOR_"*")
.D:$D(VALMDDF("INDICATOR"))&(TOSTATUS="OPEN") FLDTEXT^VALM10(IBDAIEN,"INDICATOR",$TR(CURINDICATOR,"*"))
.D:$D(VALMDDF("INDICATOR"))&(TOSTATUS="CLOSED") FLDTEXT^VALM10(IBDAIEN,"INDICATOR","C")
;
;
;I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
I $G(IBPARENT)=1 D ;TPF;IB*2*770v38;EBILL-6087
.S CURINDICATOR=$TR($$GETFLD^IBACCWLUTIL(VALMDDF("INDICATOR"),.IBDAIEN)," ") ;GET THE CURRENT VALUE IN THE FIELD.
.S PUBSUCCESS=0 D:$G(PUBLISHINGON) FIELDPUBLISH^IBACCWLUTIL1(VALMDDF("INDICATOR"),CURINDICATOR,IBENCIFN,PUBSUCCESS) ;UPDATE OTHER USERS WITH THIS ENCOUNTER IN THEIR DISPLAY
;
;TPF;IB*2*770v25;BEGIN EBILL-5122
I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
.N VALMAR,VALMDDF ;NEEDED FOR CALLS TO LM APIs
.S VALMAR=IBFROMVALMDDF(1,"VALMAR")
.M VALMDDF=IBFROMVALMDDF
.S CURINDICATOR=$TR($$GETFLD^IBACCWLUTIL(IBFROMVALMDDF("INDICATOR"),.IBDAIEN)," ") ;GET THE CURRENT VALUE IN THE FIELD.
.D:$D(IBFROMVALMDDF("INDICATOR"))&(TOSTATUS="IN PROGRESS") FLDTEXT^VALM10(IBDAIEN,"INDICATOR",CURINDICATOR_"*")
.D:$D(IBFROMVALMDDF("INDICATOR"))&(TOSTATUS="OPEN") FLDTEXT^VALM10(IBDAIEN,"INDICATOR",$TR(CURINDICATOR,"*"))
.D:$D(IBFROMVALMDDF("INDICATOR"))&(TOSTATUS="CLOSED") FLDTEXT^VALM10(IBDAIEN,"INDICATOR","C")
.S PUBSUCCESS=0 D:$G(PUBLISHINGON) FIELDPUBLISH^IBACCWLUTIL1(IBFROMVALMDDF("INDICATOR"),CURINDICATOR,IBENCIFN,PUBSUCCESS) ;UPDATE OTHER USERS WITH THIS ENCOUNTER IN THEIR DISPLAY
;TPF;IB*2*770v25;END EBILL-5122
;
;SET PREV ACVIVITY ENTRY FOR AUDIT WITH CODE 507
;UPDATE PREVIOUS ACTIVITY
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)=507 ;507 STATUS UPDATE USING 'RS Review Status' ACTION ITEM
S ADDFDA(364.94,ADDIENS,.04)=$G(USERGROUP)
;
D UPDATE^DIE("ES","ADDFDA","ADDIENS","ADDERR")
;
I $D(ADDERR) D Q ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
.W !!,"Problem adding Previous Activity Multiple for Encounter. Report to eBilling"
.S VALMBCK="R"
.W !,$G(ADDERR("DIERR",1,"TEXT",1))
.N DIR,DIRUT,DUOUT,DTOUT
.D PAUSE^VALM1
;
S DA=ADDIENS(1)
S DA(1)=IBENCIFN
;
S PREVACTIENS=$$IENS^DILF(.DA)
I BATCHITEM=1 D Q
.W !!,"Enter a reason for updating the status without reassigning the encounter."
.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 ;THIS MEANS WE HAVE ALREADY CREATED A COMMENT WHEN BATCHITEM=1
.K WPERR D EDITPREVACT^IBACCWLUTIL(PREVACTIENS,.BATCHCOMMENT,.WPERR)
.I $D(WPERR) D ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
..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
;
;D PATINSUR^IBACCWLAI
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCCOMMON VIEW PT INSURANCE
PATINSUR ;EP - VIEW/EDIT PATIENT INSURANCE
N DFN,IBVIEW,IBIFN,IBENCIEN,IBBILL
;
N VALMSG ; WCJ;v39;purple;IB*2.0*770;EBILL-5623
S VALMSG="Enter ?? for more actions" ;IB*2.0*770;EBILL-5623
;
I '$G(IBDA) N IBDA D SEL(.IBDA)
;
I '$D(IBDA) S VALMBCK="R" Q ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
;
I $G(IBDA(IBDA))["----------------------",'$O(IBDA(IBDA)) S VALMBCK="R" Q
;
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 IBIFN'="" D
.S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2)
.S IBBILL=$P($G(^DGCR(399,IBIFN,0)),U)
E W !!,"This encounter does not have a K#."
;
I '$G(DFN) D Q ;TPF;IB*2*770V6 ;PI API DOES NOT REQUIRE A K# ONLY A DFN ;TPF;IB*2*770v12;EBILL-4533
.W !,"This encounter does not have a Patient record in VistA." ;TPF;IB*2*770v12;EBILL-4533
.W !,"THIS ACTION CANNOT BE EXECUTED!!"
.S DFN="NOT FOUND"
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
.S VALMBCK="R"
;
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
D FULL^VALM1
;
;TAZ*IB*2*770v24;EBILL-5064 - Only IV can edit insurance
I SESSIONKEY="IBACCIV" S IBVIEW=0 D EN^VALM("IBCNS PATIENT INSURANCE") S VALMBCK="R" Q ;EDIT
S IBVIEW=1 D EN^VALM("IBCNS VIEW PAT INS") ;VIEW ONLY
;
S VALMBCK="R"
Q
;
;D PROVMAIN^IBACCWLAI
;CALLED BY ACTION PROTOCOLS:
;IBACC WL IBACCFRT PROV MAIN
PROVMAIN ;EP - Takes the user to the Provider ID Maintenance Menu
;
N DFN,IBIFN,IBENCIEN,IBBILL ;TPF;IB*2*770v12
N VALMSG ; WCJ;v39;purple;IB*2.0*770;EBILL-5623
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help" ;WCJ;v39;purple;IB*2.0*770;EBILL-5623
S VALMSG="Enter ?? for more actions" ;IB*2.0*770;EBILL-5623
;
;THERE IS NO NEED FOR THE USER TO SELECT A RECORD FOR THE PM ACTION ITEM BUT CJ FELT
;WE SHOULD NOT THROW A CURVE AT THEM
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 $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"
;
W:$G(IBBILL)'="" !,"ACC CLAIM/BILL "_IBBILL_" SELECTED" H 2
;
D NEWPROVMAIN^IBACCWLUTIL4 ;TPF;IB*2*770v32;EBILL-5411 SAC SIZE LIMIT
;
S VALMBCK="R"
Q
;
;CALLED BY OPTION [IBACC WL PREVIOUS ACT. REVIEW
PREVREVIEW ;EP - PREVIOUS ACTIVITY REVIEW FOR AUDITING
;
N DASHLINE,DIC,I,IBDA,IBQUIT,IEN,LINENUM,LISTTEMP,LISTTEMPIEN,VALMAR,VALMDDF,Y ;TPF;IB*2*770v14:EBILL-4580
N IBIFN ;TPF;IB*2*770v51;EBILL-6178
N VALMEVL ;TPF;IB*2*770v52;EBILL-6230
;
S VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
;
S DIC="^IBA(364.9,"
;ALLOW THE DISPLAY OF ENCOUNTERS WITH A K# NO MATTER WHAT STATUS
; STATUS 2=CLOSED 3=PURGED CLAIM NUMBER NULL (K#)
;S DIC("S")="I ($P(^(0),U,16)=2!($P(^(0),U,16)=3)),($P($G(^(2)),U,2)="""")" ;$P(^IBA(364,9,IEN,0,U,16) STATUS MUST BE CLOSED OR PURGED
; ;$P(^IBA(364.9,IEN,2),U,2) AND NO K#
S DIC("S")="I ($P(^(0),U,16)=2!($P(^(0),U,16)=3))" ;TPF;IB*2*770v51;EBILL-6178
;
S DIC(0)="AEMBQ"
S DIC("A")="Select PATIENT NAME:"
D ^DIC
Q:Y<0
;
S IBENCIFN=+Y
;
;FIRST DO A DETAIL REPORT #364.9
;THIS WILL PULL ANY IELD STILL POPULATED EVEN IF PARTIALLY PURGED
S $P(DASHLINE,"-",IOM)=""
S LISTTEMP="IBACC WL PREV. ACTIVITY VIEWER"
S LISTTEMPIEN=$O(^SD(409.61,"B",LISTTEMP,""))
I 'LISTTEMPIEN D Q
.W !!,"REQUIRED LIST TEMPLATE "_LISTTEMP_" NOT FOUND!!"
.N DIR
.D PAUSE^VALM1
;
S VALMAR=$P($G(^SD(409.61,LISTTEMPIEN,"ARRAY"))," ",2)
K @VALMAR
;
S I=0
F S I=$O(^SD(409.61,LISTTEMPIEN,"COL",I)) Q:'I I $D(^(I,0)) S VALMDDF($P(^(0),U))=^(0)
;
S IBIFN="" ;THERE IS NO BILL INFO. WE SCREENED THOSE OUT
S IBDA="" ;OBSOLETE
N DETRETURN
D INIT^IBACCWLEE(IBDA,IBENCIFN,IBIFN)
;
;BEGIN TPF;IB*2*770v51;EBILL-6178 ADD VE TO AWL
;
S LISTTEMP="IBACC WL VE"
S LISTTEMPIEN=$O(^SD(409.61,"B",LISTTEMP,""))
I 'LISTTEMPIEN D Q
.W !!,"REQUIRED LIST TEMPLATE "_LISTTEMP_" NOT FOUND!!"
.N DIR
.D PAUSE^VALM1
;
K VALMDDF
S I=0
F S I=$O(^SD(409.61,LISTTEMPIEN,"COL",I)) Q:'I I $D(^(I,0)) S VALMDDF($P(^(0),U))=^(0)
;
S VALMEVL=1 ;TPF;IB*2*770v52;EBILL-????;THIS IS A LM VAR. SET BECAUSE WE ENTERED INIT^IBACCWLVE AND IT USES LM SPECIAL VARS
S (IORVON,IORVOFF)="" ;SINCE THIS DISPLAY DOES NOT USE A LM SCREEN SPECIAL CHAR VARS WILL NOT WORK
S IBIFN=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"I")
;
;I $G(IBIFN)'=""
D INIT^IBACCWLVE ;TPF:IB*2*770v53;EBILL-6262 AMY TESTED AND SAID THEY WANT THE VE REGARDLESS OF k# OR NOT
;
;END TPF;IB*2*770v51;EBILL-6178
S PAGE=1
S SUBHEADER="ACC ENCOUNTER FIELDS #364.9"
D HDR(.PAGE,SUBHEADER)
S IEN=0
F LINENUM=1:1 S IEN=$O(@VALMAR@(IEN)) Q:'IEN D Q:$G(IBQUIT)
.I $Y>(IOSL-5) D PAUSE(.IBQUIT) Q:$G(IBQUIT) D HDR(.PAGE,SUBHEADER)
.;W !,@VALMAR@(IEN,0)
.I ($L(@VALMAR@(IEN,0))>80),($E(@VALMAR@(IEN,0),81)'=" ") D ;TPF;IB*2*770v50;EBILL-6174
..D WORDWRAP^IBACCWLPREV(@VALMAR@(IEN,0),29) ;MOVED THIS LINE DOWN TO PRESERVE $T FOR ELSE 10 IS AN INDEMT FOR THE SECOND LINE. VALUE OUT OF THE AIR
.E W !,$E(@VALMAR@(IEN,0),1,80) ;TPF;IB*2*770v51;EBILL-6174
;
W !!,$$CJ^XLFSTR("****END OF "_SUBHEADER_"****",IOM)
W !,$$CJ^XLFSTR("END OF REPORT",IOM)
;
K ^TMP("IBACCWLVE",$J) ;IB*2*770v53;EBILL-6264
K ^TMP("IBACCWLPREV",$J) ;IB*2*770v53;EBILL-6264
K ^TMP("VALM VIDEO",$J) ;IB*2*770v53;EBILL-6264
;
N DIR
D PAUSE^VALM1
;
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("")) ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
;
Q
;
PAUSE(IBQUIT) ; CONT?
W !
N DIR,DIRUT,DUOUT,DTOUT
S DIR(0)="E"
D ^DIR
I $D(DIRUT)!($D(DUOUT))!($D(DTOUT)) S IBQUIT=1
Q
;
HDR(PAGE,SUBHEADER) ;EP - HEADER
W @IOF
W !!,$$CJ^XLFSTR("IBACC WL PREVIOUS ACT. REVIEW",IOM)
W !,$$CJ^XLFSTR(SUBHEADER,IOM),?55,$$RJ^XLFSTR("PAGE: "_PAGE,IOM)
W !,DASHLINE
W !
S PAGE=PAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLAIVIEW 17886 printed May 25, 2026@12:09:51 Page 2
IBACCWLAIVIEW ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Items related to Viewing Bill or Encounter data ; 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 ;
+5 ;D VIEWSERCON^IBACCWLAI
+6 ;CALLED BY ACTION PROTOCOLS:
+7 ;IBACC WL IBACCCOMMON VIEW SERV CONNECTED
VIEWSERCON(IBDA) ;EP - VIEW SERVICE CONNECTED DATA
+1 NEW CNT,DFN,GREF,IBBILL,IBDATE,IBIFN,IBNAME,IBENCIFN,IBCLELIG
+2 ;
+3 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+4 ;
+5 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+6 ;
+7 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+8 ;
+9 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+10 ;
+11 ;I VALMAR[("IBACCWLEE") D
+12 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+13 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+14 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+17 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+18 ;
+19 IF IBENCIFN
IF '$GET(DFN)
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+20 IF '$TEST
SET DFN="NOT FOUND"
+21 ;
+22 ;TPF;IB*2*770v12;BEGIN EBILL-5131
+23 IF IBIFN'=""
Begin DoDot:1
+24 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+25 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+26 IF '$TEST
WRITE !!,"This encounter does not have a K#."
+27 ;
+28 IF '$GET(DFN)
Begin DoDot:1
+29 WRITE !,"This encounter does not have a Patient record in VistA."
+30 WRITE !,"THIS ACTION CANNOT BE EXECUTED!!"
+31 SET DFN="NOT FOUND"
+32 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+33 DO PAUSE^VALM1
+34 SET VALMBCK="R"
End DoDot:1
QUIT
+35 ;TPF;IB*2*770v25;BEGIN EBILL-5131
+36 ;
+37 if $GET(IBBILL)'=""
WRITE !,"ACC ENCOUNTER/CLAIM "_IBBILL_" SELECTED"
HANG 2
+38 if $GET(DFN)
WRITE !,"PATIENT FOUND: ",$PIECE($GET(^DPT(DFN,0)),U)
+39 ;
+40 DO EN^IBACCWLVS(DFN)
+41 SET VALMBCK="R"
+42 ;
+43 QUIT
+44 ;
+45 ;D VIEWENCOUNTER^IBACCWLAI Gives user a view only screen that displays Encounter (#364.9) displayed on the Worklist
+46 ;CALLED BY ACTION PROTOCOLS:
+47 ;IBACC WL IBACCCOMMON VIEW ENCOUNTER
VIEWENCOUNTER ;EP - VIEW READABLE ACC ENCOUNTER. ISN'T THIS IN EE?
+1 NEW DFN,IBBILL,IBENCIFN,IBIFN,IBENCIEN
+2 ;TPF;IB*2*770v53;EBILL-6203
NEW STOP
+3 ;
+4 ;CHECK TO SEE IF USER ALREADY HAS INSTANTIATED VE
+5 ;TPF;IB*2*770v38;EBILL-5485
+6 ;BEGIN;TPF;BEGIN;IB*2*770v53;EBILL-6262
+7 IF $GET(SESSIONKEY)'="IBACCBILL"
IF $DATA(^TMP("IBACCWLVE",$JOB))
SET VALMBCK="R"
QUIT
+8 ;
+9 IF $GET(SESSIONKEY)="IBACCBILL"
Begin DoDot:1
+10 IF ($GET(IBREGVE)=1)
IF $DATA(^TMP("IBACCWLVE",$JOB))
SET VALMBCK="R"
SET STOP=1
QUIT
+11 IF ($GET(IBREGVE)=0)
IF $DATA(^TMP("IBACCWLBILLVE",$JOB))
SET VALMBCK="R"
SET STOP=1
QUIT
End DoDot:1
if $GET(STOP)
QUIT
+12 ;END;TPF;BEGIN;IB*2*770v53;EBILL-6262
+13 ;
+14 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+15 ;
+16 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+17 ;
+18 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+19 ;
+20 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+21 ;
+22 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+23 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+24 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+27 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+28 ;
+29 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+30 IF '$TEST
SET DFN="NOT FOUND"
+31 ;
+32 DO FULL^VALM1
+33 ;
+34 ;RUR GETS VE PLUS ALL ACTIONS THEY HAVE ON EE
+35 ;WE COULD SPLIT THE FLOW HERE FOR TWO DIFFERENT VEs FOR RUR AND ALL OTHERS.
+36 ;OR SPLIT IT IN D EN^IBACCWLVE AND CALL A DIFFERENT LIST TEMPLATE THERE?
+37 ;I VALMAR[("IBACCWLRUR")!($G(IBFROMVALMDDF(1,"NAME"))[("RUR")) D EN^IBACCWLVERUR(.IBDA,.IBFROMVALMDDF) S VALMBCK="R" Q ;TPF;IB*2*770v38;EBILL-5485
+38 ;
+39 ;BEGIN TPF;IB*2*770v38;EBILL-5485 ADDED BECAUSE VE IS ACCESSBLE FROM BOTH PARENT WL AND EE
+40 ;M IBFROMVALMDDF=VALMDDF ;PASS THE COLUMN SPECS AND ORIGINATING DATA ARRAY FOR UPDATING WHEN ACTION DONE IN EE
+41 ;M IBFROMVALMDDF("HDR")=VALMHDR ;TPF;IB*2*770v48;EBILL-6100 NOT USED
+42 ;S IBFROMVALMDDF(1,"NAME")=$G(NAME)
+43 ;S IBFROMVALMDDF(1,"VALMAR")=$G(VALMAR)
+44 ;TPF;IB*2*770v49;EBILL-6100 THE PARENT COL DEFINITION SETS SHOULD ONLY OCCUR IF COMING IN FROM THE PARENT NOT A CHILD SCREEN
IF $GET(IBPARENT)
Begin DoDot:1
+45 MERGE IBFROMVALMDDF=VALMDDF
+46 SET IBFROMVALMDDF(1,"NAME")=$GET(NAME)
+47 SET IBFROMVALMDDF(1,"VALMAR")=$GET(VALMAR)
End DoDot:1
+48 MERGE DETRETURN=ENCRETURN(IBDA)
+49 SET PREVVALMAR=$PIECE($NAME(@VALMAR),")")_")"
+50 ;END TPF;IB*2*770v38;EBILL-5485
+51 ;
+52 ;TPF;IB*2*770v48;EBILL-6100 MOVED FROM ABOVE IBFROMVALMDDF SETTING
+53 ;TPF;IB*2*770v38;EBILL-5485
IF VALMAR[("IBACCWLRUR")!($GET(IBFROMVALMDDF(1,"NAME"))[("RUR"))
DO EN^IBACCWLVERUR(.IBDA,.IBFROMVALMDDF)
SET VALMBCK="R"
QUIT
+54 ;
+55 ;TPF;IB*2*770v53;EBILL-6203
IF $GET(IBREGVE)'=1
IF ($GET(SESSIONKEY)="IBACCBILL")
DO EN^IBACCWLBILLVE
SET VALMBCK="R"
QUIT
+56 ;
+57 ;ALL OTHER WORKGROUPS USE THIS CALL FOR VIEW RAW X12 ENCOUNTER
+58 DO EN^IBACCWLVE
+59 ;
+60 SET IBICAMEFROMEE=1
+61 ;S IBACCWLBILLVELEV=1 ;TPF;IB*2*770v53;EBILL-6203;TPF;IB*2*770v62;EBILL-6615
+62 SET VALMBCK="R"
+63 QUIT
+64 ;
+65 ;D REVSTATUS^IBACCWLAI
+66 ;CALLED BY ACTION PROTOCOLS:
+67 ;IBACC WL IBACCCOMMON REVIEW STATUS
REVSTATUS(IBDA) ;EP - REVIEW/EDIT ACC CLAIM STATUS
+1 NEW BATCHITEM,BATCHSTATUS,BATCHCOMMENT,CURASSIGGRP,DA,DIE,DR,IBDAIEN
+2 ;
+3 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+4 ;
+5 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA,"L")
+6 ;
+7 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+8 ;
+9 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+10 ;
+11 ;CHECK SELECTED RECORDS TO SEE IF THEY HAVE BEEN REASSIGNED. IF IN THE "UNAVAILABLE STATUS' REMOVE FROM BATCH
+12 DO AVAILABLECHK^IBACCWLUTIL1(.IBDA)
+13 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+14 ;TPF;IB*2*770v22;BEGIN EBILL-4920 CORRECTION TO ERROR RESOLUTION FOUND DURING EBILL-4055
IF IBDA("TOTAL")=1
IF ('$DATA(IBDA(IBDA)))
SET VALMBCK="R"
QUIT
+15 ;
+16 ;GET STATUS THE USER WISHES TO APPLY TO THE BATCH. 1=REQUIRED
IF IBDA("TOTAL")>1
SET BATCHSTATUS=$$ASKSTATUS^IBACCWLUTIL1(1)
IF BATCHSTATUS=0
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 IBDAIEN=""
+21 FOR BATCHITEM=1:1
SET IBDAIEN=$ORDER(IBDA(IBDAIEN))
if 'IBDAIEN
QUIT
Begin DoDot:1
+22 if $GET(IBDA(IBDAIEN))["----------------------"
QUIT
+23 DO REVSTATUSLOOP(.IBDAIEN,BATCHITEM,.BATCHCOMMENT,$GET(BATCHSTATUS))
End DoDot:1
+24 ;
+25 ;TPF;IB*2*770v10;EBILL-4490
SET VALMBCK="R"
+26 ;
+27 QUIT
+28 ;
REVSTATUSLOOP(IBDAIEN,BATCHITEM,BATCHCOMMENT,BATCHSTATUS) ;EP - LOOP REVSTATUS
+1 ;
+2 NEW ADDERR,ADDIENS,ADDFDA,ADDERR,CURASSIGGRP,CURINDICATOR,FROMSTATUS,TOSTATUS,IBIFN,IBENCIEN,DFN,IBBILL
+3 ;
+4 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+5 ;
+6 WRITE !!,"PROCESSING RECORD: ",$GET(IBDAIEN)
+7 ;
+8 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+9 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+10 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET IBIFN=$GET(@VALMAR@(IBDAIEN,"IEN399",1))
+13 SET IBENCIFN=$GET(@VALMAR@(IBDAIEN,"IEN3649",1))
End DoDot:1
+14 ;
+15 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+16 IF '$TEST
SET DFN="NOT FOUND"
+17 ;
+18 IF IBIFN'=""
Begin DoDot:1
+19 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+20 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 WRITE !!,"This encounter does not have a K#."
End DoDot:1
+23 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+24 ;
+25 DO FULL^VALM1
+26 SET CURASSIGGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01)
+27 SET FROMSTATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16)
+28 ;
+29 SET CURASSIGGRP=$$GET1^DIQ(364.9,IBENCIFN_",",3.01,"")
+30 WRITE !,"CURRENT ASSIGNED TO GROUP: "_CURASSIGGRP
+31 ;
+32 ;_" TO "_$G(TOSTATUS)
WRITE !,"CURRENT STATUS "_$GET(FROMSTATUS)
+33 IF IBDA("TOTAL")>1
DO UPDSTATUS^IBACCWLUTIL(IBENCIFN,BATCHSTATUS)
+34 ;
+35 IF IBDA("TOTAL")=1
Begin DoDot:1
+36 DO EDITSTATUS^IBACCWLUTIL(IBENCIFN,FROMSTATUS,0)
End DoDot:1
+37 ;
+38 SET TOSTATUS=$$GET1^DIQ(364.9,IBENCIFN_",",.16)
+39 ;NO NEED FOR AN AUDIT ENTRY IN PREVIOUS ACTIVITY IF NO CHANGE IN STATUS
IF IBDA("TOTAL")=1
IF (FROMSTATUS=TOSTATUS)
SET VALMBCK="R"
QUIT
+40 ;
+41 ;EBILL-9999 no change in STATUS creates PREV ACT - should not
IF IBDA("TOTAL")>1
IF (FROMSTATUS=BATCHSTATUS)
SET VALMBCK="R"
QUIT
+42 ;
+43 ;UPDATE THIS USER'S SCREEN LIST
+44 MERGE IBDAIEN(IBDAIEN)=IBDA(IBDAIEN)
+45 ;
+46 ;I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
+47 ;TPF;IB*2*770v38;EBILL-6087
IF $GET(IBPARENT)=1
Begin DoDot:1
+48 ;GET THE CURRENT VALUE IN THE FIELD.
SET CURINDICATOR=$TRANSLATE($$GETFLD^IBACCWLUTIL(VALMDDF("INDICATOR"),.IBDAIEN)," ")
+49 if $DATA(VALMDDF("INDICATOR"))&(TOSTATUS="IN PROGRESS")
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR",CURINDICATOR_"*")
+50 if $DATA(VALMDDF("INDICATOR"))&(TOSTATUS="OPEN")
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR",$TRANSLATE(CURINDICATOR,"*"))
+51 if $DATA(VALMDDF("INDICATOR"))&(TOSTATUS="CLOSED")
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR","C")
End DoDot:1
+52 ;
+53 ;
+54 ;I $G(IBPARENT)=0 D ;TPF;IB*2*770v38;EBILL-5485
+55 ;TPF;IB*2*770v38;EBILL-6087
IF $GET(IBPARENT)=1
Begin DoDot:1
+56 ;GET THE CURRENT VALUE IN THE FIELD.
SET CURINDICATOR=$TRANSLATE($$GETFLD^IBACCWLUTIL(VALMDDF("INDICATOR"),.IBDAIEN)," ")
+57 ;UPDATE OTHER USERS WITH THIS ENCOUNTER IN THEIR DISPLAY
SET PUBSUCCESS=0
if $GET(PUBLISHINGON)
DO FIELDPUBLISH^IBACCWLUTIL1(VALMDDF("INDICATOR"),CURINDICATOR,IBENCIFN,PUBSUCCESS)
End DoDot:1
+58 ;
+59 ;TPF;IB*2*770v25;BEGIN EBILL-5122
+60 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+61 ;NEEDED FOR CALLS TO LM APIs
NEW VALMAR,VALMDDF
+62 SET VALMAR=IBFROMVALMDDF(1,"VALMAR")
+63 MERGE VALMDDF=IBFROMVALMDDF
+64 ;GET THE CURRENT VALUE IN THE FIELD.
SET CURINDICATOR=$TRANSLATE($$GETFLD^IBACCWLUTIL(IBFROMVALMDDF("INDICATOR"),.IBDAIEN)," ")
+65 if $DATA(IBFROMVALMDDF("INDICATOR"))&(TOSTATUS="IN PROGRESS")
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR",CURINDICATOR_"*")
+66 if $DATA(IBFROMVALMDDF("INDICATOR"))&(TOSTATUS="OPEN")
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR",$TRANSLATE(CURINDICATOR,"*"))
+67 if $DATA(IBFROMVALMDDF("INDICATOR"))&(TOSTATUS="CLOSED")
DO FLDTEXT^VALM10(IBDAIEN,"INDICATOR","C")
+68 ;UPDATE OTHER USERS WITH THIS ENCOUNTER IN THEIR DISPLAY
SET PUBSUCCESS=0
if $GET(PUBLISHINGON)
DO FIELDPUBLISH^IBACCWLUTIL1(IBFROMVALMDDF("INDICATOR"),CURINDICATOR,IBENCIFN,PUBSUCCESS)
End DoDot:1
+69 ;TPF;IB*2*770v25;END EBILL-5122
+70 ;
+71 ;SET PREV ACVIVITY ENTRY FOR AUDIT WITH CODE 507
+72 ;UPDATE PREVIOUS ACTIVITY
+73 SET ADDIENS="+1,"_IBENCIFN_","
+74 SET ADDFDA(364.94,ADDIENS,.01)="NOW"
+75 SET ADDFDA(364.94,ADDIENS,.02)="`"_$GET(DUZ)
+76 ;507 STATUS UPDATE USING 'RS Review Status' ACTION ITEM
SET ADDFDA(364.94,ADDIENS,.03)=507
+77 SET ADDFDA(364.94,ADDIENS,.04)=$GET(USERGROUP)
+78 ;
+79 DO UPDATE^DIE("ES","ADDFDA","ADDIENS","ADDERR")
+80 ;
+81 ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
IF $DATA(ADDERR)
Begin DoDot:1
+82 WRITE !!,"Problem adding Previous Activity Multiple for Encounter. Report to eBilling"
+83 SET VALMBCK="R"
+84 WRITE !,$GET(ADDERR("DIERR",1,"TEXT",1))
+85 NEW DIR,DIRUT,DUOUT,DTOUT
+86 DO PAUSE^VALM1
End DoDot:1
QUIT
+87 ;
+88 SET DA=ADDIENS(1)
+89 SET DA(1)=IBENCIFN
+90 ;
+91 SET PREVACTIENS=$$IENS^DILF(.DA)
+92 IF BATCHITEM=1
Begin DoDot:1
+93 WRITE !!,"Enter a reason for updating the status without reassigning the encounter."
+94 ;TPF;IB*2*770v38;EBILL-5825
WRITE !,"This comment will be applied to "_$SELECT($GET(IBDA("TOTAL"))>1:"the entire batch.",1:"this encounter.")
+95 WRITE !
+96 ;
+97 SET DIE="^IBA(364.9,"_DA(1)_",4,"
+98 SET DR=""
+99 SET DR=DR_"10"
+100 DO ^DIE
+101 DO GETS^DIQ(364.94,PREVACTIENS,"**","EIR","PREVACTRET","ERROR")
+102 MERGE BATCHCOMMENT=PREVACTRET(364.94,PREVACTIENS,"PREVIOUS ACTIVITY COMMENTS")
+103 KILL BATCHCOMMENT("E")
+104 KILL BATCHCOMMENT("I")
End DoDot:1
QUIT
+105 ;
+106 ;THIS MEANS WE HAVE ALREADY CREATED A COMMENT WHEN BATCHITEM=1
IF BATCHITEM>1
IF $DATA(BATCHCOMMENT)
Begin DoDot:1
+107 KILL WPERR
DO EDITPREVACT^IBACCWLUTIL(PREVACTIENS,.BATCHCOMMENT,.WPERR)
+108 ;TPF;IB*2*770v11;EBILL-4523 ;CHANGE TO SOP FOR ERROR CHECKS IN WL
IF $DATA(WPERR)
Begin DoDot:2
+109 WRITE !!,"Problem adding comment to Encounter. Report to eBilling"
+110 SET VALMBCK="R"
+111 WRITE !,$GET(WPERR("DIERR",1,"TEXT",1))
+112 NEW DIR,DIRUT,DUOUT,DTOUT
+113 DO PAUSE^VALM1
End DoDot:2
End DoDot:1
QUIT
+114 ;
+115 SET VALMBCK="R"
+116 ;
+117 QUIT
+118 ;
+119 ;D PATINSUR^IBACCWLAI
+120 ;CALLED BY ACTION PROTOCOLS:
+121 ;IBACC WL IBACCCOMMON VIEW PT INSURANCE
PATINSUR ;EP - VIEW/EDIT PATIENT INSURANCE
+1 NEW DFN,IBVIEW,IBIFN,IBENCIEN,IBBILL
+2 ;
+3 ; WCJ;v39;purple;IB*2.0*770;EBILL-5623
NEW VALMSG
+4 ;IB*2.0*770;EBILL-5623
SET VALMSG="Enter ?? for more actions"
+5 ;
+6 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+7 ;
+8 ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+9 ;
+10 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+11 ;
+12 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+13 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+14 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+17 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+18 ;
+19 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+20 IF '$TEST
SET DFN="NOT FOUND"
+21 ;
+22 IF IBIFN'=""
Begin DoDot:1
+23 SET DFN=$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
+24 SET IBBILL=$PIECE($GET(^DGCR(399,IBIFN,0)),U)
End DoDot:1
+25 IF '$TEST
WRITE !!,"This encounter does not have a K#."
+26 ;
+27 ;TPF;IB*2*770V6 ;PI API DOES NOT REQUIRE A K# ONLY A DFN ;TPF;IB*2*770v12;EBILL-4533
IF '$GET(DFN)
Begin DoDot:1
+28 ;TPF;IB*2*770v12;EBILL-4533
WRITE !,"This encounter does not have a Patient record in VistA."
+29 WRITE !,"THIS ACTION CANNOT BE EXECUTED!!"
+30 SET DFN="NOT FOUND"
+31 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+32 DO PAUSE^VALM1
+33 SET VALMBCK="R"
End DoDot:1
QUIT
+34 ;
+35 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+36 ;
+37 DO FULL^VALM1
+38 ;
+39 ;TAZ*IB*2*770v24;EBILL-5064 - Only IV can edit insurance
+40 ;EDIT
IF SESSIONKEY="IBACCIV"
SET IBVIEW=0
DO EN^VALM("IBCNS PATIENT INSURANCE")
SET VALMBCK="R"
QUIT
+41 ;VIEW ONLY
SET IBVIEW=1
DO EN^VALM("IBCNS VIEW PAT INS")
+42 ;
+43 SET VALMBCK="R"
+44 QUIT
+45 ;
+46 ;D PROVMAIN^IBACCWLAI
+47 ;CALLED BY ACTION PROTOCOLS:
+48 ;IBACC WL IBACCFRT PROV MAIN
PROVMAIN ;EP - Takes the user to the Provider ID Maintenance Menu
+1 ;
+2 ;TPF;IB*2*770v12
NEW DFN,IBIFN,IBENCIEN,IBBILL
+3 ; WCJ;v39;purple;IB*2.0*770;EBILL-5623
NEW VALMSG
+4 ;WCJ;v39;purple;IB*2.0*770;EBILL-5623
SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+5 ;IB*2.0*770;EBILL-5623
SET VALMSG="Enter ?? for more actions"
+6 ;
+7 ;THERE IS NO NEED FOR THE USER TO SELECT A RECORD FOR THE PM ACTION ITEM BUT CJ FELT
+8 ;WE SHOULD NOT THROW A CURVE AT THEM
+9 IF '$GET(IBDA)
NEW IBDA
DO SEL(.IBDA)
+10 ;
+11 IF '$DATA(IBDA)
SET VALMBCK="R"
QUIT
+12 ;
+13 IF $GET(IBDA(IBDA))["----------------------"
IF '$ORDER(IBDA(IBDA))
SET VALMBCK="R"
QUIT
+14 ;
+15 ;TPF;IB*2*770v38;EBILL-5485
IF $GET(IBPARENT)=0
Begin DoDot:1
+16 SET IBENCIFN=$GET(@VALMAR@("IEN3649",1))
+17 SET IBIFN=$GET(@VALMAR@("IEN399",1))
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 SET IBIFN=$GET(@VALMAR@(IBDA,"IEN399",1))
+20 SET IBENCIFN=$GET(@VALMAR@(IBDA,"IEN3649",1))
End DoDot:1
+21 ;
+22 IF IBENCIFN
SET DFN=$PIECE($GET(^IBA(364.9,IBENCIFN,2)),U)
+23 IF '$TEST
SET DFN="NOT FOUND"
+24 ;
+25 if $GET(IBBILL)'=""
WRITE !,"ACC CLAIM/BILL "_IBBILL_" SELECTED"
HANG 2
+26 ;
+27 ;TPF;IB*2*770v32;EBILL-5411 SAC SIZE LIMIT
DO NEWPROVMAIN^IBACCWLUTIL4
+28 ;
+29 SET VALMBCK="R"
+30 QUIT
+31 ;
+32 ;CALLED BY OPTION [IBACC WL PREVIOUS ACT. REVIEW
PREVREVIEW ;EP - PREVIOUS ACTIVITY REVIEW FOR AUDITING
+1 ;
+2 ;TPF;IB*2*770v14:EBILL-4580
NEW DASHLINE,DIC,I,IBDA,IBQUIT,IEN,LINENUM,LISTTEMP,LISTTEMPIEN,VALMAR,VALMDDF,Y
+3 ;TPF;IB*2*770v51;EBILL-6178
NEW IBIFN
+4 ;TPF;IB*2*770v52;EBILL-6230
NEW VALMEVL
+5 ;
+6 SET VALMSG="* = In progress| ! = Patient not in VistA |??=Help"
+7 ;
+8 SET DIC="^IBA(364.9,"
+9 ;ALLOW THE DISPLAY OF ENCOUNTERS WITH A K# NO MATTER WHAT STATUS
+10 ; STATUS 2=CLOSED 3=PURGED CLAIM NUMBER NULL (K#)
+11 ;S DIC("S")="I ($P(^(0),U,16)=2!($P(^(0),U,16)=3)),($P($G(^(2)),U,2)="""")" ;$P(^IBA(364,9,IEN,0,U,16) STATUS MUST BE CLOSED OR PURGED
+12 ; ;$P(^IBA(364.9,IEN,2),U,2) AND NO K#
+13 ;TPF;IB*2*770v51;EBILL-6178
SET DIC("S")="I ($P(^(0),U,16)=2!($P(^(0),U,16)=3))"
+14 ;
+15 SET DIC(0)="AEMBQ"
+16 SET DIC("A")="Select PATIENT NAME:"
+17 DO ^DIC
+18 if Y<0
QUIT
+19 ;
+20 SET IBENCIFN=+Y
+21 ;
+22 ;FIRST DO A DETAIL REPORT #364.9
+23 ;THIS WILL PULL ANY IELD STILL POPULATED EVEN IF PARTIALLY PURGED
+24 SET $PIECE(DASHLINE,"-",IOM)=""
+25 SET LISTTEMP="IBACC WL PREV. ACTIVITY VIEWER"
+26 SET LISTTEMPIEN=$ORDER(^SD(409.61,"B",LISTTEMP,""))
+27 IF 'LISTTEMPIEN
Begin DoDot:1
+28 WRITE !!,"REQUIRED LIST TEMPLATE "_LISTTEMP_" NOT FOUND!!"
+29 NEW DIR
+30 DO PAUSE^VALM1
End DoDot:1
QUIT
+31 ;
+32 SET VALMAR=$PIECE($GET(^SD(409.61,LISTTEMPIEN,"ARRAY"))," ",2)
+33 KILL @VALMAR
+34 ;
+35 SET I=0
+36 FOR
SET I=$ORDER(^SD(409.61,LISTTEMPIEN,"COL",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET VALMDDF($PIECE(^(0),U))=^(0)
+37 ;
+38 ;THERE IS NO BILL INFO. WE SCREENED THOSE OUT
SET IBIFN=""
+39 ;OBSOLETE
SET IBDA=""
+40 NEW DETRETURN
+41 DO INIT^IBACCWLEE(IBDA,IBENCIFN,IBIFN)
+42 ;
+43 ;BEGIN TPF;IB*2*770v51;EBILL-6178 ADD VE TO AWL
+44 ;
+45 SET LISTTEMP="IBACC WL VE"
+46 SET LISTTEMPIEN=$ORDER(^SD(409.61,"B",LISTTEMP,""))
+47 IF 'LISTTEMPIEN
Begin DoDot:1
+48 WRITE !!,"REQUIRED LIST TEMPLATE "_LISTTEMP_" NOT FOUND!!"
+49 NEW DIR
+50 DO PAUSE^VALM1
End DoDot:1
QUIT
+51 ;
+52 KILL VALMDDF
+53 SET I=0
+54 FOR
SET I=$ORDER(^SD(409.61,LISTTEMPIEN,"COL",I))
if 'I
QUIT
IF $DATA(^(I,0))
SET VALMDDF($PIECE(^(0),U))=^(0)
+55 ;
+56 ;TPF;IB*2*770v52;EBILL-????;THIS IS A LM VAR. SET BECAUSE WE ENTERED INIT^IBACCWLVE AND IT USES LM SPECIAL VARS
SET VALMEVL=1
+57 ;SINCE THIS DISPLAY DOES NOT USE A LM SCREEN SPECIAL CHAR VARS WILL NOT WORK
SET (IORVON,IORVOFF)=""
+58 SET IBIFN=$$GET1^DIQ(364.9,IBENCIFN_",",2.02,"I")
+59 ;
+60 ;I $G(IBIFN)'=""
+61 ;TPF:IB*2*770v53;EBILL-6262 AMY TESTED AND SAID THEY WANT THE VE REGARDLESS OF k# OR NOT
DO INIT^IBACCWLVE
+62 ;
+63 ;END TPF;IB*2*770v51;EBILL-6178
+64 SET PAGE=1
+65 SET SUBHEADER="ACC ENCOUNTER FIELDS #364.9"
+66 DO HDR(.PAGE,SUBHEADER)
+67 SET IEN=0
+68 FOR LINENUM=1:1
SET IEN=$ORDER(@VALMAR@(IEN))
if 'IEN
QUIT
Begin DoDot:1
+69 IF $Y>(IOSL-5)
DO PAUSE(.IBQUIT)
if $GET(IBQUIT)
QUIT
DO HDR(.PAGE,SUBHEADER)
+70 ;W !,@VALMAR@(IEN,0)
+71 ;TPF;IB*2*770v50;EBILL-6174
IF ($LENGTH(@VALMAR@(IEN,0))>80)
IF ($EXTRACT(@VALMAR@(IEN,0),81)'=" ")
Begin DoDot:2
+72 ;MOVED THIS LINE DOWN TO PRESERVE $T FOR ELSE 10 IS AN INDEMT FOR THE SECOND LINE. VALUE OUT OF THE AIR
DO WORDWRAP^IBACCWLPREV(@VALMAR@(IEN,0),29)
End DoDot:2
+73 ;TPF;IB*2*770v51;EBILL-6174
IF '$TEST
WRITE !,$EXTRACT(@VALMAR@(IEN,0),1,80)
End DoDot:1
if $GET(IBQUIT)
QUIT
+74 ;
+75 WRITE !!,$$CJ^XLFSTR("****END OF "_SUBHEADER_"****",IOM)
+76 WRITE !,$$CJ^XLFSTR("END OF REPORT",IOM)
+77 ;
+78 ;IB*2*770v53;EBILL-6264
KILL ^TMP("IBACCWLVE",$JOB)
+79 ;IB*2*770v53;EBILL-6264
KILL ^TMP("IBACCWLPREV",$JOB)
+80 ;IB*2*770v53;EBILL-6264
KILL ^TMP("VALM VIDEO",$JOB)
+81 ;
+82 NEW DIR
+83 DO PAUSE^VALM1
+84 ;
+85 QUIT
+86 ;
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 ;ONLY IF ONE SELECTION. NEED FOR LOOP FOR MULTIPLES
SET IBDA=$ORDER(IBDA(""))
+12 ;
+13 QUIT
+14 ;
PAUSE(IBQUIT) ; CONT?
+1 WRITE !
+2 NEW DIR,DIRUT,DUOUT,DTOUT
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))
SET IBQUIT=1
+6 QUIT
+7 ;
HDR(PAGE,SUBHEADER) ;EP - HEADER
+1 WRITE @IOF
+2 WRITE !!,$$CJ^XLFSTR("IBACC WL PREVIOUS ACT. REVIEW",IOM)
+3 WRITE !,$$CJ^XLFSTR(SUBHEADER,IOM),?55,$$RJ^XLFSTR("PAGE: "_PAGE,IOM)
+4 WRITE !,DASHLINE
+5 WRITE !
+6 SET PAGE=PAGE+1
+7 QUIT
