IBACCWL1 ;EDE/TPF - ACC (Automated Community Care) Encounters - COMMON LIST TEMPLATE API (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 is a generic ACC (Automated Community care Claims) worklist LM (List Manager) generated
;option for working claims placed in an exception status by the incoming ACC claim processor
;
;D INIT^XPDID ;ICR# 2172
;
SET(X,VALMCNT,RECORDNUM,IEN399,GREF) ;EP -
;
S VALMCNT=VALMCNT+1
S @GREF@(VALMCNT,0)=X
S @GREF@(VALMCNT,"IEN3649",1)=$P($G(IEN399),U,2)
S @GREF@(VALMCNT,"IEN399",1)=$P($G(IEN399),U)
S:$P($G(IEN399),U,2)'="" @GREF@("IEN3649",$P($G(IEN399),U,2))=$G(VALMCNT,0)
S @GREF@("IDX",VALMCNT,RECORDNUM)=""
;
Q
;
SETSUB(X,VALMCNT,LINENUM,IEN,GREF,SUBLINE) ;EP -
S VALMCNT=VALMCNT+1
S @GREF@(LINENUM,SUBLINE)=X
;
Q
;
PULLLIST(IBDAYSMAX,IBBILLER,IBDIV,IBSORT,EEPULL) ;EP - PULL DATA FROM FILE #364.9
;
N ACCENC
N ASSGNGRP,AUTH,BILLRETURN,BIREPREADY,ERROR,FIELDS,FILE,FIRSTNAME,FLAGS,FORMTYPE,FROM,IBIFN,IBENCIFN,IENS,IDENTIFIER,INDEX,LASTNAME,LISTRETURN,MIDNAME,NEWSCREEN
;TAZ;IB*2.0*770v20;EBILL-4965 - Added REASONS to the New list
N PATDOB,PATSSN,PART,PATTYPE,PREVATC,PROCTYPE,PROVIDER,PROVNPI,PRIMDX,PRIMINS,PTNAME,REASCODE,REASON,REASONS,REASSGRP
N RETURN,RETURNREC,SCREEN,SITENUM,STATUS,SECINS,TEMPRETURN,TERTINS,X12CLAIM
N CPUSTART,CPUEND,CPUELAPSED
N LINENUM,XPDIDTOT,XPDIDVT,IOBM ;TPF XINDEX
;
;TPF;IB*2*770v38;EBILL-5485
S (IBACCWLVELEV,IBACCWLEELEV,IBACCWLRURREVLEV)=0 ;RESET CHILD LEVEL TO 0
;
S PART(1)=USERGROUP
S:PART(1)="SUP" PART(1)="" ;FOR DEVELOPERS AND DEBUGGING
I '$D(PART) W !!,"CANNOT DO PULL IF NO USER GROUP!!" Q
;
S FILE=364.9
S IENS=""
S FIELDS=";.02I;.03I;.04I;.11I;.12EI;.15;.2EI;2.01EI;2.02EI"
;
S FLAGS="IE"
S FROM(1)=""
;S MAXNUMBER=20000 ;SET IN A PARAMETER FILE?
;
S INDEX="AC"
S SCREEN="I $P(^(0),U,16)'=2,($P(^(0),U,16)'=3)"
;
S NEWSCREEN="I $$DAYSSCREEN^IBACCWLUTIL(DT,$P(^(3),U,3),"_$G(IBDAYSMAX)_")" ;CHANGE TO ASSIGNED DATE ;TPF;IB*2*770v20;EBILL-4969
I $D(IBDIV) S NEWSCREEN=NEWSCREEN_",($P(^(0),U,20)'=""""&$D(IBDIV($P(^(0),U,20))))" ;WRONG? THIS CODE ASSUMES DIVISION IS STORED IN FIELD .2 OF #364.9 ;TPF;IB*2*770v18;EBILL-4623;FOR SUBSORTS OR "FILTER"
;
S SCREEN=SCREEN_" "_NEWSCREEN
S IDENTIFIER=""
;
;TPF;IB*2*770v20;EBILL-4631;FOR SORT "FILTER"
D:$D(IBSORTFIL) ADDFILTERS^IBACCWLUTIL2(.SCREEN,.IBSORTFIL)
;
K ^TMP("IBACCUTIL",$J)
S LISTRETURN="^TMP(""IBACCUTIL"",$J,"""_USERGROUP_""")"
K @LISTRETURN
;
S CPUSTART=$$CPUTIME^XLFSHAN
D INIT^XPDID ;ICR #2172 (Supported)
D TITLE^XPDID("LOADING "_USERGROUP_" ENCOUNTERS NOW...") ;ICR #2172 (Supported)
W !!,"NUMBER OF RECORDS LOADING "_$G(MAXNUMBER)
W !,"CALLING DATA EXTRACTION API"
;
W !!,"SEARCHING RECORDS BASED ON USER CRITERIA"
;
D LIST^DIC(FILE,IENS,FIELDS,FLAGS,MAXNUMBER,.FROM,.PART,INDEX,.SCREEN,IDENTIFIER,LISTRETURN,"ERROR")
;
S XPDIDTOT=$P($G(@LISTRETURN@("DILIST",0)),U) ;SET FOR PROGRESS BAR
;
S CPUEND=$$CPUTIME^XLFSHAN
S CPUELAPSED=$$ETIMEMS^XLFSHAN(CPUSTART,CPUEND)
I $$ISTESTER^IBACCWLUTIL($G(DUZ)) D
.W !!,"TIME ELAPSE FOR WORK GROUP DATA EXTRACTION"
.W !,"CPU TIME: "_CPUELAPSED
.W !,"CPU seconds: "_(+CPUELAPSED*.015)
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
I $D(ERROR) D Q
.W !!,"Error occurred Main Extract. Report to eBilling"
.W !,$G(ERROR("DIERR",1,"TEXT",1))
.D APPERROR^%ZTER("ERROR ON LIST^DIC CALL - PULLIST^IBACCWL1 - Call eBilling") ;TPF;IB*2*770v34
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
W !,"EXTRACTING DATA AND SORTING WORKLIST"
;
S CPUSTART=$$CPUTIME^XLFSHAN
;
S RETURNREC=0
F S RETURNREC=$O(@LISTRETURN@("DILIST","ID",RETURNREC)) Q:'RETURNREC!(+RETURNREC'=RETURNREC) D
.S IBENCIFN=@LISTRETURN@("DILIST",2,RETURNREC) ;IEN OF #364.9
.S IBIFN=$G(@LISTRETURN@("DILIST","ID",RETURNREC,2.02,"I")) ;PTR TO 399
.;
.W:'(RETURNREC#1000) "."
.;
.S XPDIDVT=1
.S IOBM=IOSL-4
.D UPDATE^XPDID(RETURNREC) ;ICR #2172 (Supported)
.;
.K @LISTRETURN@("DILIST",2,RETURNREC)
.K @LISTRETURN@("DILIST","ID",RETURNREC)
.;
.D PULL3649(IBIFN,IBENCIFN,.ENCRETURN,RETURNREC,EEPULL)
.;
;
S CPUEND=$$CPUTIME^XLFSHAN
S CPUELAPSED=$$ETIMEMS^XLFSHAN(CPUSTART,CPUEND)
I $$ISTESTER^IBACCWLUTIL($G(DUZ)) D
.W !!,"TIME ELAPSE FOR WL CREATION AND SORTING"
.W !,"CPU TIME: "_CPUELAPSED
.W !,"CPU seconds: "_(+CPUELAPSED*.015)
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
S (LINENUM,VALMCNT)=0
D SETARRAY(.LINENUM,.VALMCNT)
;
D EXIT^XPDID("RECORD LOAD COMPLETE") ;ICR #2172 (Supported)
I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
K ^TMP("IBACCUTIL",$J)
;
Q
;
PULL3649(IBIFN,IBENCIFN,ENCRETURN,RETURNREC,EEPULL) ;EP -
;
N ACTRETURN,ACTCODEIENS,BILLRETURN,ENCIENS,ERROR,FLAGS,FIELDS,LASTONE,PREVACTIVITY,PREVACTIEN,REASIEN,REASONS,REASONPTR,REASCODE,REASERROR,REASONPT,RETURN,SSN
N RSNPTR ;TPF XINDEX
;
S ENCIENS=IBENCIFN_","
S FIELDS=".01;.02;.03;.04;.05;.06;.07;.08;.09;.1;.11;.12;.13;.14;.15;.16;.17;.18;.2"
S FIELDS=FIELDS_";.23;.25;.26;.27;.28;.29;.3;2.01;2.02;2.03;3.01;3.03;3.04" ;TPF;IB*2*770v26;EBILL-5242
S FLAGS="ERI"
;
I $G(EEPULL) D
.S FLAGS="ERIN"
.S FIELDS="**"
S RETURN="^TMP(""IBACCUTIL"",$J,"_RETURNREC_")"
K @RETURN
;
D GETS^DIQ(364.9,ENCIENS,FIELDS,FLAGS,RETURN,"ERROR")
;
I $D(ERROR) D Q
.W !!,"Error occurred in file #364.9 extract. Report to eBilling"
.W !,$G(ERROR("DIERR",1,"TEXT",1))
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
S PREVACTIEN=$O(^IBA(364.9,+ENCIENS,4,99999),-1)
I PREVACTIEN D
.;S ACTCODEIENS=$P(^IBA(364.9,+ENCIENS,4,PREVACTIEN,0),U,3)_","
.S ACTCODEIENS=$P($G(^IBA(364.9,+ENCIENS,4,PREVACTIEN,0)),U,3) ;TPF;IB*2*770v48
.Q:ACTCODEIENS=""
.S ACTCODEIENS=ACTCODEIENS_","
.D GETS^DIQ(364.92,ACTCODEIENS,".01;.02;","E","ACTRETURN","ACTERROR")
.S PREVACTIVITY=$G(ACTRETURN(364.92,ACTCODEIENS,.01,"E"))_" "_$E($G(ACTRETURN(364.92,ACTCODEIENS,.02,"E")),1,50)
.S ^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PREVACT","E")=PREVACTIVITY
;
;TAZ;IB*2.0*770v20;EBILL-4965 - Display only the Error Code Text applicable to the worklist
D GETS^DIQ(364.9,ENCIENS,"4*;5*","EIN","REASONS","ERROR")
I $D(REASONS(364.95)) D
. N RSN,RSNARY,RSNDATA,RSNIEN
. S REASON="",RSNIEN=0
. F S RSNIEN=$O(REASONS(364.95,RSNIEN)) Q:'RSNIEN D I REASON]"" Q
.. I USERGROUP'=$G(REASONS(364.95,RSNIEN,.03,"I")) Q
.. S RSNPTR=$G(REASONS(364.95,RSNIEN,.01,"I"))_","
.. D GETS^DIQ(364.91,RSNPTR,".01;.02","E","RSNDATA","ERROR")
.. S REASON=$$RJ^XLFSTR($G(RSNDATA(364.91,RSNPTR,.01,"E")),3," ")_" "_$G(RSNDATA(364.91,RSNPTR,.02,"E"))
. I REASON="" S REASON="PASSED FROM "_$G(REASONS(364.94,$O(REASONS(364.94,""),-1),.04,"E"))
. S ^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"REASONS","E")=REASON
;
;TPF;IB*2*770v18;EBILL-4623
I $D(VALMDDF("SSN")) D
.I $P(VALMDDF("SSN"),U,3)'=9 D
..S ^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E")=$E($G(^TMP("IBACCUTIL",$J,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E")),6,9)
;
I $G(IBIFN) D PULL399(IBIFN,.BILLRETURN,RETURNREC,EEPULL)
;
D SORTSET^IBACCWLSORT1(RETURN,ENCIENS,.BILLRETURN,IBIFN,RETURNREC)
;
K RETURN,ENCIENS
;
Q
;
PULL399(IBIFN,BILLRETURN,RETURNREC,FULLPULL) ;EP - PULL DATA FROM 399
;
N BILLIENS,ERROR,FIELDS,FLAGS
;
S BILLIENS=IBIFN_","
S FIELDS=".01;.02;.03;.05;.19;.22;11;101;102;151;201;202"
S FLAGS="ERIN"
;
I $G(FULLPULL) D
.S FLAGS="ERIN"
.S FIELDS="**"
;
D GETS^DIQ(399,BILLIENS,FIELDS,FLAGS,"BILLRETURN","ERROR")
;
I $D(ERROR) D Q
.W !!,"Error occurred in file #399 extract. Report to eBilling"
.W !,$G(ERROR("DIERR",1,"TEXT",1))
.N DIR ;TPF;IB*2*770v47;EBILL-6042
.D PAUSE^VALM1
;
D GETS^DIQ(399.0304,BILLIENS_"1,","**",FLAGS,"BILLRETURN","ERROR")
;
Q
;
SETARRAY(LINENUM,VALMCNT) ;EP - NEW SET ARRAY WITH NEW SORT ^TMP("IBACCUTIL",$J,"SORTED" SORTED DATA
;
N ASSIGNEDGRP,BILLIEN,BILLNUM,BILLIENS,CHARGEAMT,CLAIMNUM,CPT,DATAFLAG,DATEASSIGNED,DAYSONWL,DAYSONGRPWL,DIVISION,DIVNAME,DOB,ENCIEN,EXTSERVDATE,FILENUM,FILENUM,FIELDNAME,FIELDVALUEREF,FIRSTDAY,FORMTYPE,GLOREF
N OLDIENS,PAIDAMT,PATIEN,PATNOTFOUND,PATTYPE,PAYERCON,PREVACT,PRIDX,PRIMESORT,PRIMINSUR,PROVIDER,PROVNPI,PTIEN,PTNAME,REASCODE,ROOTREF,SECINSUR,SECONDX,SECSORT,SERVCON
N SORTCOUNT,SORTTYPE,SSN,STATUS,TERTINSUR,TERTSORT,TODAY,VISMARK,X1,X2,X ;TPF;IB*2*770v11;EBILL-4507
N SERVFACNM,SERVFACNPI ;TPF;IB*2*770v11;EBILL-4507
N PRIMDXDESC ;TPF XINDEX
;
S SORTCOUNT=0
F SORTTYPE="K# SORTED","NO K# SORTED" D
.;
.S ROOTREF="^TMP(""IBACCUTIL"","_$J_","""_SORTTYPE_""")"
.S OLDIENS="START"
.S GLOREF=ROOTREF
.F S GLOREF=$Q(@GLOREF) Q:GLOREF="" Q:$QS(GLOREF,3)'=SORTTYPE D
..;
..I SORTTYPE="NO K# SORTED",'SORTCOUNT D
...S SORTCOUNT=1
...;
...;INSERT K# SEPARATOR LINE
...I $D(^TMP("IBACCUTIL",$J,"K# SORTED")) D
....S LINENUM=LINENUM+1
....D SORTLINE^IBACCWLUTIL(.VALMDDF,LINENUM,.LINE)
....D SET(LINE,.VALMCNT,.LINENUM,$G(BILLIEN)_U_$G(ENCIEN),VALMAR)
..;
..S PRIMESORT=$QS(GLOREF,4)
..S SECSORT=$QS(GLOREF,5)
..S TERTSORT=$QS(GLOREF,6)
..S FILENUM=$QS(GLOREF,7)
..S ENCIENS=$QS(GLOREF,8)
..S FIELDNAME=$QS(GLOREF,9)
..S DATAFLAG=$QS(GLOREF,10)
..S X=""
..;
..S ENCIEN=+ENCIENS
..Q:ENCIENS=OLDIENS
..S LINENUM=LINENUM+1
..S OLDIENS=ENCIENS
..;
..S FIELDVALUEREF=$NA(@GLOREF,8)
..S X=$$SETFLD^VALM1(LINENUM,X,"LINENUM")
..;
..S CLAIMNUM=$G(@FIELDVALUEREF@("X12 CLAIM NUMBER","E"))
..S BILLNUM=CLAIMNUM
..S BILLNUM=$G(@FIELDVALUEREF@("CLAIM NUMBER","E"))
..S BILLIEN=$G(@FIELDVALUEREF@("CLAIM NUMBER","I"))
..;
..I $D(VALMDDF("BILLNUM")) D
...S CLAIMNUM=$E(CLAIMNUM,($L(CLAIMNUM)-$P(VALMDDF("BILLNUM"),U,3))+1,$L(CLAIMNUM))
...S:BILLNUM="" BILLNUM=CLAIMNUM
...S X=$$SETFLD^VALM1(BILLNUM,X,"BILLNUM")
..;
..S EXTSERVDATE=$G(@FIELDVALUEREF@("SERVICE DATE","I"))
..S EXTSERVDATE=$$FMTE^XLFDT(EXTSERVDATE,"2ZD")
..I $D(VALMDDF("SERVDATE")) S X=$$SETFLD^VALM1(EXTSERVDATE,X,"SERVDATE")
..;
..I $D(@FIELDVALUEREF@("PATIENT")) D
...S PTNAME=$G(@FIELDVALUEREF@("PATIENT","E"))
...S PATIEN=$G(@FIELDVALUEREF@("PATIENT","I"))
..;
..I $G(PTNAME)="" D
...S PTNAME=$G(@FIELDVALUEREF@("PATIENT LAST NAME","E"))_", "_$G(@FIELDVALUEREF@("PATIENT FIRST NAME","E"))_" "_$G(@FIELDVALUEREF@("PATIENT MIDDLE NAME","E"))
..S X=$$SETFLD^VALM1(PTNAME,X,"PTNAME")
..;
..I $D(VALMDDF("SSN")) D ;TPF;IB*2*770v18;EBILL-4623
...S SSN=$G(@FIELDVALUEREF@("PATIENT SSN","E"))
...S X=$$SETFLD^VALM1(SSN,X,"SSN")
..;
..S DOB=$G(@FIELDVALUEREF@("PATIENT DOB","I"))
..S DOB=$$FMTE^XLFDT(DOB,"2ZD")
..I $D(VALMDDF("DOB")) S X=$$SETFLD^VALM1(DOB,X,"DOB")
..;
..S CPT=$G(@FIELDVALUEREF@("CPT","E"))
..I $D(VALMDDF("CPT")) S X=$$SETFLD^VALM1(CPT,X,"CPT")
..;
..I $D(VALMDDF("PRIMDX")) D ;TPF;IB*2*770v18;EBILL-4623
...S PRIMDX=$G(@FIELDVALUEREF@("PRIMARY DX","E"))
...S PRIMDXDESC=$$ICDLKUP^IBACCWLUTIL1(PRIMDX)
...S PRIMDX=PRIMDXDESC ;TPF;IB*2*770v20;EBILL-4971
...S X=$$SETFLD^VALM1(PRIMDX,X,"PRIMDX")
..;
..S SECONDX=$G(@FIELDVALUEREF@("SECONDARY DX","E")) ;TPF*IB*2*770v20;EBILL=4928
..S SECONDX=$$CONVERT2DEC^IBACCWLUTIL1(SECONDX)
..I $D(VALMDDF("SECONDX")) S X=$$SETFLD^VALM1(SECONDX,X,"SECONDX")
..;
..I $D(VALMDDF("PAYERCON")) D ;TPF;IB*2*770v18;EBILL-4665
...S PAYERCON=$G(@FIELDVALUEREF@("PAYER CLAIM CONTROL NUMBER","E"))
...S X=$$SETFLD^VALM1($E(PAYERCON,1,$P(VALMDDF("PAYERCON"),U,3)-1),X,"PAYERCON")
..;
..S PATTYPE=$P($G(@FIELDVALUEREF@("IN-PATIENT/OUT-PATIENT","E")),"-")
..I $D(VALMDDF("PATTYPE")) S X=$$SETFLD^VALM1(PATTYPE,X,"PATTYPE")
..;
..S FORMTYPE=$G(@FIELDVALUEREF@("FORM TYPE","E"))
..S FORMTYPE=$S(FORMTYPE[("CMS"):$P(FORMTYPE,"-",2),FORMTYPE[("J"):$E(FORMTYPE,1,4),1:$TR(FORMTYPE,"-"))
..I $D(VALMDDF("FORMTYPE")) S X=$$SETFLD^VALM1(FORMTYPE,X,"FORMTYPE")
..;
..S PRIMINSUR=$G(@FIELDVALUEREF@("PRIMARY INS","E"))
..I $D(VALMDDF("PRIMINSUR")) S X=$$SETFLD^VALM1($E(PRIMINSUR,1,$P(VALMDDF("PRIMINSUR"),U,3)-1),X,"PRIMINSUR")
..;
..S SECINSUR=$G(@FIELDVALUEREF@("SECONDARY INS","E"))
..I $D(VALMDDF("SECINSUR")) S X=$$SETFLD^VALM1($E(SECINSUR,1,$P(VALMDDF("SECINSUR"),U,3)),X,"SECINSUR")
..;
..S TERTINSUR=$G(@FIELDVALUEREF@("TERTIARY INS","E")) ;NOT USED
..;
..;TPF;IB*2*770v26;EBILL-5242
..I $G(PATIEN) S SERVCON=$$ISSPECAUTH^IBACCWLUTIL1(PATIEN)
..E S SERVCON=" / "
..I $D(VALMDDF("SERVCON")) S X=$$SETFLD^VALM1(SERVCON,X,"SERVCON")
..;
..S PROVIDER=$G(@FIELDVALUEREF@("PROVIDER","E"))
..I $D(VALMDDF("PROVIDER")) S X=$$SETFLD^VALM1($E(PROVIDER,1,$P(VALMDDF("PROVIDER"),U,3)),X,"PROVIDER")
..;
..S PROVNPI=$G(@FIELDVALUEREF@("PROVIDER NPI","E"))
..I $D(VALMDDF("PROVNPI")) S X=$$SETFLD^VALM1(PROVNPI,X,"PROVNPI") ;TPF;IB*2*770v11;EBILL-4509
..;
..S REASCODE=$G(@FIELDVALUEREF@("REASONS","E"))
..I $D(VALMDDF("REASCODE")) S X=$$SETFLD^VALM1($E(REASCODE,1,$P(VALMDDF("REASCODE"),U,3)-1),X,"REASCODE") ;TPF;IB*2*770v8;EBILL-4439
..;
..S DAYSONGRPWL=$J($G(@FIELDVALUEREF@("DAYS ON GROUP WORKLIST","E")),4) ;TPF;IB*2*770v14;EBILL-4574
..I $D(VALMDDF("DAYSONGRPWL")) S X=$$SETFLD^VALM1(DAYSONGRPWL,X,"DAYSONGRPWL")
..;
..;NEW SPECS ;TPF;IB*2*770v11;EBILL-4507
..S SERVFACNM=$G(@FIELDVALUEREF@("SERVICE FACILITY","E")) ;TPF;IB*2*770v11;EBILL-4507
..I $D(VALMDDF("SERVFACNM")) S X=$$SETFLD^VALM1(SERVFACNM,X,"SERVFACNM") ;TPF;IB*2*770v11;EBILL-4507
..;
..S SERVFACNPI=$G(@FIELDVALUEREF@("SERVICE FACILITY NPI","E")) ;TPF;IB*2*770v11;EBILL-4507
..I $D(VALMDDF("FACNPI")) S X=$$SETFLD^VALM1(SERVFACNPI,X,"FACNPI") ;TPF;IB*2*770v11;EBILL-4507
..;
..I $D(VALMDDF("DIVNAME")) D ;TPF;IB*2*770v18;EBILL-4623
...S (DIVNAME,DIVISION)=$G(@FIELDVALUEREF@("SITE NUMBER","E"))
...S:DIVISION DIVISION=$$LKUP^XUAF4(DIVISION)
...I DIVISION S DIVNAME=$$GET1^DIQ(4,DIVISION_",",.01,"E")
...S X=$$SETFLD^VALM1(DIVNAME,X,"DIVNAME")
..;
..S PAIDAMT=$G(@FIELDVALUEREF@("PAID AMOUNT","E")) ;TPF;IB*2*770v18;EBILL-4623
..I $D(VALMDDF("PAIDAMT")),PAIDAMT D
...S PAIDAMT=$FN(PAIDAMT,",",2)
...S PAIDAMT=$J(PAIDAMT,$P(VALMDDF("PAIDAMT"),U,3))
...S X=$$SETFLD^VALM1(PAIDAMT,X,"PAIDAMT") ;TPF;IB*2*770v18;EBILL-4623
..;
..S CHARGEAMT=$G(@FIELDVALUEREF@("CHARGE AMOUNT","E")) ;TPF;IB*2*770v18;EBILL-4623
..I $D(VALMDDF("CHARGEAMT")) S X=$$SETFLD^VALM1(CHARGEAMT,X,"CHARGEAMT") ;TPF;IB*2*770v18;EBILL-4623
..;
..S ASSIGNEDGRP=$G(@FIELDVALUEREF@("ASSIGNED TO GROUP","I"))
..I $D(VALMDDF("ASSIGNEDGRP")) S X=$$SETFLD^VALM1(ASSIGNEDGRP,X,"ASSIGNEDGRP")
..;
..S DATEASSIGNED=$G(@FIELDVALUEREF@("DATE ASSIGNED","I"))
..S DATEASSIGNED=$$FMTE^XLFDT(DATEASSIGNED,"2ZD")
..I $D(VALMDDF("DATEASSNED")) S X=$$SETFLD^VALM1(DATEASSIGNED,X,"DATEASSNED")
..;
..S PREVACT=$G(@FIELDVALUEREF@("PREVACT","E"))
..I $D(VALMDDF("PREVACT")) S X=$$SETFLD^VALM1(PREVACT,X,"PREVACT")
..;
..S PATNOTFOUND=($P($G(^IBA(364.9,+ENCIENS,2)),U)="") ;TPF;IB*2*770v15;EBILL-4611
..S STATUS=$G(@FIELDVALUEREF@("STATUS","I"))
..S VISMARK=$S(PATNOTFOUND:"!",1:"")
..S VISMARK=VISMARK_$S(STATUS=1:"*",1:"") ;* = 'IN PROGRESS' ! = PAT NOT IN #200
..I $D(VALMDDF("INDICATOR")) S X=$$SETFLD^VALM1(VISMARK,X,"INDICATOR")
..;
..D SET(X,.VALMCNT,.LINENUM,BILLIEN_U_ENCIEN,VALMAR)
..;
;
Q
;
NODATA(TEXT,RECORDNUM) ;EP - DISPLAY ERROR IN LM DISPLAY WINDOW
N DATA,DATAIEN
M DATA=TEXT
S RECORD=""
S X=""
;
S RECORDNUM=RECORDNUM+1 ;EMPTY LINE
D SET("",.VALMCNT,.RECORDNUM,"",VALMAR)
;
S DATAIEN=0
F S DATAIEN=$O(DATA(DATAIEN)) Q:DATAIEN="" D
.S RECORDNUM=RECORDNUM+1
.S RECORD=$$SETFLD^VALM1(DATA(DATAIEN),RECORD,"PTNAME")
.D SET(RECORD,.VALMCNT,.RECORDNUM,"",VALMAR)
;
S RECORDNUM=RECORDNUM+1
D SET("",.VALMCNT,.RECORDNUM,"",VALMAR)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWL1 15971 printed May 25, 2026@12:09:46 Page 2
IBACCWL1 ;EDE/TPF - ACC (Automated Community Care) Encounters - COMMON LIST TEMPLATE API (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 is a generic ACC (Automated Community care Claims) worklist LM (List Manager) generated
+5 ;option for working claims placed in an exception status by the incoming ACC claim processor
+6 ;
+7 ;D INIT^XPDID ;ICR# 2172
+8 ;
SET(X,VALMCNT,RECORDNUM,IEN399,GREF) ;EP -
+1 ;
+2 SET VALMCNT=VALMCNT+1
+3 SET @GREF@(VALMCNT,0)=X
+4 SET @GREF@(VALMCNT,"IEN3649",1)=$PIECE($GET(IEN399),U,2)
+5 SET @GREF@(VALMCNT,"IEN399",1)=$PIECE($GET(IEN399),U)
+6 if $PIECE($GET(IEN399),U,2)'=""
SET @GREF@("IEN3649",$PIECE($GET(IEN399),U,2))=$GET(VALMCNT,0)
+7 SET @GREF@("IDX",VALMCNT,RECORDNUM)=""
+8 ;
+9 QUIT
+10 ;
SETSUB(X,VALMCNT,LINENUM,IEN,GREF,SUBLINE) ;EP -
+1 SET VALMCNT=VALMCNT+1
+2 SET @GREF@(LINENUM,SUBLINE)=X
+3 ;
+4 QUIT
+5 ;
PULLLIST(IBDAYSMAX,IBBILLER,IBDIV,IBSORT,EEPULL) ;EP - PULL DATA FROM FILE #364.9
+1 ;
+2 NEW ACCENC
+3 NEW ASSGNGRP,AUTH,BILLRETURN,BIREPREADY,ERROR,FIELDS,FILE,FIRSTNAME,FLAGS,FORMTYPE,FROM,IBIFN,IBENCIFN,IENS,IDENTIFIER,INDEX,LASTNAME,LISTRETURN,MIDNAME,NEWSCREEN
+4 ;TAZ;IB*2.0*770v20;EBILL-4965 - Added REASONS to the New list
+5 NEW PATDOB,PATSSN,PART,PATTYPE,PREVATC,PROCTYPE,PROVIDER,PROVNPI,PRIMDX,PRIMINS,PTNAME,REASCODE,REASON,REASONS,REASSGRP
+6 NEW RETURN,RETURNREC,SCREEN,SITENUM,STATUS,SECINS,TEMPRETURN,TERTINS,X12CLAIM
+7 NEW CPUSTART,CPUEND,CPUELAPSED
+8 ;TPF XINDEX
NEW LINENUM,XPDIDTOT,XPDIDVT,IOBM
+9 ;
+10 ;TPF;IB*2*770v38;EBILL-5485
+11 ;RESET CHILD LEVEL TO 0
SET (IBACCWLVELEV,IBACCWLEELEV,IBACCWLRURREVLEV)=0
+12 ;
+13 SET PART(1)=USERGROUP
+14 ;FOR DEVELOPERS AND DEBUGGING
if PART(1)="SUP"
SET PART(1)=""
+15 IF '$DATA(PART)
WRITE !!,"CANNOT DO PULL IF NO USER GROUP!!"
QUIT
+16 ;
+17 SET FILE=364.9
+18 SET IENS=""
+19 SET FIELDS=";.02I;.03I;.04I;.11I;.12EI;.15;.2EI;2.01EI;2.02EI"
+20 ;
+21 SET FLAGS="IE"
+22 SET FROM(1)=""
+23 ;S MAXNUMBER=20000 ;SET IN A PARAMETER FILE?
+24 ;
+25 SET INDEX="AC"
+26 SET SCREEN="I $P(^(0),U,16)'=2,($P(^(0),U,16)'=3)"
+27 ;
+28 ;CHANGE TO ASSIGNED DATE ;TPF;IB*2*770v20;EBILL-4969
SET NEWSCREEN="I $$DAYSSCREEN^IBACCWLUTIL(DT,$P(^(3),U,3),"_$GET(IBDAYSMAX)_")"
+29 ;WRONG? THIS CODE ASSUMES DIVISION IS STORED IN FIELD .2 OF #364.9 ;TPF;IB*2*770v18;EBILL-4623;FOR SUBSORTS OR "FILTER"
IF $DATA(IBDIV)
SET NEWSCREEN=NEWSCREEN_",($P(^(0),U,20)'=""""&$D(IBDIV($P(^(0),U,20))))"
+30 ;
+31 SET SCREEN=SCREEN_" "_NEWSCREEN
+32 SET IDENTIFIER=""
+33 ;
+34 ;TPF;IB*2*770v20;EBILL-4631;FOR SORT "FILTER"
+35 if $DATA(IBSORTFIL)
DO ADDFILTERS^IBACCWLUTIL2(.SCREEN,.IBSORTFIL)
+36 ;
+37 KILL ^TMP("IBACCUTIL",$JOB)
+38 SET LISTRETURN="^TMP(""IBACCUTIL"",$J,"""_USERGROUP_""")"
+39 KILL @LISTRETURN
+40 ;
+41 SET CPUSTART=$$CPUTIME^XLFSHAN
+42 ;ICR #2172 (Supported)
DO INIT^XPDID
+43 ;ICR #2172 (Supported)
DO TITLE^XPDID("LOADING "_USERGROUP_" ENCOUNTERS NOW...")
+44 WRITE !!,"NUMBER OF RECORDS LOADING "_$GET(MAXNUMBER)
+45 WRITE !,"CALLING DATA EXTRACTION API"
+46 ;
+47 WRITE !!,"SEARCHING RECORDS BASED ON USER CRITERIA"
+48 ;
+49 DO LIST^DIC(FILE,IENS,FIELDS,FLAGS,MAXNUMBER,.FROM,.PART,INDEX,.SCREEN,IDENTIFIER,LISTRETURN,"ERROR")
+50 ;
+51 ;SET FOR PROGRESS BAR
SET XPDIDTOT=$PIECE($GET(@LISTRETURN@("DILIST",0)),U)
+52 ;
+53 SET CPUEND=$$CPUTIME^XLFSHAN
+54 SET CPUELAPSED=$$ETIMEMS^XLFSHAN(CPUSTART,CPUEND)
+55 IF $$ISTESTER^IBACCWLUTIL($GET(DUZ))
Begin DoDot:1
+56 WRITE !!,"TIME ELAPSE FOR WORK GROUP DATA EXTRACTION"
+57 WRITE !,"CPU TIME: "_CPUELAPSED
+58 WRITE !,"CPU seconds: "_(+CPUELAPSED*.015)
+59 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+60 DO PAUSE^VALM1
End DoDot:1
+61 ;
+62 IF $DATA(ERROR)
Begin DoDot:1
+63 WRITE !!,"Error occurred Main Extract. Report to eBilling"
+64 WRITE !,$GET(ERROR("DIERR",1,"TEXT",1))
+65 ;TPF;IB*2*770v34
DO APPERROR^%ZTER("ERROR ON LIST^DIC CALL - PULLIST^IBACCWL1 - Call eBilling")
+66 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+67 DO PAUSE^VALM1
End DoDot:1
QUIT
+68 ;
+69 WRITE !,"EXTRACTING DATA AND SORTING WORKLIST"
+70 ;
+71 SET CPUSTART=$$CPUTIME^XLFSHAN
+72 ;
+73 SET RETURNREC=0
+74 FOR
SET RETURNREC=$ORDER(@LISTRETURN@("DILIST","ID",RETURNREC))
if 'RETURNREC!(+RETURNREC'=RETURNREC)
QUIT
Begin DoDot:1
+75 ;IEN OF #364.9
SET IBENCIFN=@LISTRETURN@("DILIST",2,RETURNREC)
+76 ;PTR TO 399
SET IBIFN=$GET(@LISTRETURN@("DILIST","ID",RETURNREC,2.02,"I"))
+77 ;
+78 if '(RETURNREC#1000)
WRITE "."
+79 ;
+80 SET XPDIDVT=1
+81 SET IOBM=IOSL-4
+82 ;ICR #2172 (Supported)
DO UPDATE^XPDID(RETURNREC)
+83 ;
+84 KILL @LISTRETURN@("DILIST",2,RETURNREC)
+85 KILL @LISTRETURN@("DILIST","ID",RETURNREC)
+86 ;
+87 DO PULL3649(IBIFN,IBENCIFN,.ENCRETURN,RETURNREC,EEPULL)
+88 ;
End DoDot:1
+89 ;
+90 SET CPUEND=$$CPUTIME^XLFSHAN
+91 SET CPUELAPSED=$$ETIMEMS^XLFSHAN(CPUSTART,CPUEND)
+92 IF $$ISTESTER^IBACCWLUTIL($GET(DUZ))
Begin DoDot:1
+93 WRITE !!,"TIME ELAPSE FOR WL CREATION AND SORTING"
+94 WRITE !,"CPU TIME: "_CPUELAPSED
+95 WRITE !,"CPU seconds: "_(+CPUELAPSED*.015)
+96 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+97 DO PAUSE^VALM1
End DoDot:1
+98 ;
+99 SET (LINENUM,VALMCNT)=0
+100 DO SETARRAY(.LINENUM,.VALMCNT)
+101 ;
+102 ;ICR #2172 (Supported)
DO EXIT^XPDID("RECORD LOAD COMPLETE")
+103 IF '$DATA(IOUON)!'$DATA(IORVON)
DO ENS^%ZISS
+104 KILL ^TMP("IBACCUTIL",$JOB)
+105 ;
+106 QUIT
+107 ;
PULL3649(IBIFN,IBENCIFN,ENCRETURN,RETURNREC,EEPULL) ;EP -
+1 ;
+2 NEW ACTRETURN,ACTCODEIENS,BILLRETURN,ENCIENS,ERROR,FLAGS,FIELDS,LASTONE,PREVACTIVITY,PREVACTIEN,REASIEN,REASONS,REASONPTR,REASCODE,REASERROR,REASONPT,RETURN,SSN
+3 ;TPF XINDEX
NEW RSNPTR
+4 ;
+5 SET ENCIENS=IBENCIFN_","
+6 SET FIELDS=".01;.02;.03;.04;.05;.06;.07;.08;.09;.1;.11;.12;.13;.14;.15;.16;.17;.18;.2"
+7 ;TPF;IB*2*770v26;EBILL-5242
SET FIELDS=FIELDS_";.23;.25;.26;.27;.28;.29;.3;2.01;2.02;2.03;3.01;3.03;3.04"
+8 SET FLAGS="ERI"
+9 ;
+10 IF $GET(EEPULL)
Begin DoDot:1
+11 SET FLAGS="ERIN"
+12 SET FIELDS="**"
End DoDot:1
+13 SET RETURN="^TMP(""IBACCUTIL"",$J,"_RETURNREC_")"
+14 KILL @RETURN
+15 ;
+16 DO GETS^DIQ(364.9,ENCIENS,FIELDS,FLAGS,RETURN,"ERROR")
+17 ;
+18 IF $DATA(ERROR)
Begin DoDot:1
+19 WRITE !!,"Error occurred in file #364.9 extract. Report to eBilling"
+20 WRITE !,$GET(ERROR("DIERR",1,"TEXT",1))
+21 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+22 DO PAUSE^VALM1
End DoDot:1
QUIT
+23 ;
+24 SET PREVACTIEN=$ORDER(^IBA(364.9,+ENCIENS,4,99999),-1)
+25 IF PREVACTIEN
Begin DoDot:1
+26 ;S ACTCODEIENS=$P(^IBA(364.9,+ENCIENS,4,PREVACTIEN,0),U,3)_","
+27 ;TPF;IB*2*770v48
SET ACTCODEIENS=$PIECE($GET(^IBA(364.9,+ENCIENS,4,PREVACTIEN,0)),U,3)
+28 if ACTCODEIENS=""
QUIT
+29 SET ACTCODEIENS=ACTCODEIENS_","
+30 DO GETS^DIQ(364.92,ACTCODEIENS,".01;.02;","E","ACTRETURN","ACTERROR")
+31 SET PREVACTIVITY=$GET(ACTRETURN(364.92,ACTCODEIENS,.01,"E"))_" "_$EXTRACT($GET(ACTRETURN(364.92,ACTCODEIENS,.02,"E")),1,50)
+32 SET ^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PREVACT","E")=PREVACTIVITY
End DoDot:1
+33 ;
+34 ;TAZ;IB*2.0*770v20;EBILL-4965 - Display only the Error Code Text applicable to the worklist
+35 DO GETS^DIQ(364.9,ENCIENS,"4*;5*","EIN","REASONS","ERROR")
+36 IF $DATA(REASONS(364.95))
Begin DoDot:1
+37 NEW RSN,RSNARY,RSNDATA,RSNIEN
+38 SET REASON=""
SET RSNIEN=0
+39 FOR
SET RSNIEN=$ORDER(REASONS(364.95,RSNIEN))
if 'RSNIEN
QUIT
Begin DoDot:2
+40 IF USERGROUP'=$GET(REASONS(364.95,RSNIEN,.03,"I"))
QUIT
+41 SET RSNPTR=$GET(REASONS(364.95,RSNIEN,.01,"I"))_","
+42 DO GETS^DIQ(364.91,RSNPTR,".01;.02","E","RSNDATA","ERROR")
+43 SET REASON=$$RJ^XLFSTR($GET(RSNDATA(364.91,RSNPTR,.01,"E")),3," ")_" "_$GET(RSNDATA(364.91,RSNPTR,.02,"E"))
End DoDot:2
IF REASON]""
QUIT
+44 IF REASON=""
SET REASON="PASSED FROM "_$GET(REASONS(364.94,$ORDER(REASONS(364.94,""),-1),.04,"E"))
+45 SET ^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"REASONS","E")=REASON
End DoDot:1
+46 ;
+47 ;TPF;IB*2*770v18;EBILL-4623
+48 IF $DATA(VALMDDF("SSN"))
Begin DoDot:1
+49 IF $PIECE(VALMDDF("SSN"),U,3)'=9
Begin DoDot:2
+50 SET ^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E")=$EXTRACT($GET(^TMP("IBACCUTIL",$JOB,RETURNREC,364.9,ENCIENS,"PATIENT SSN","E")),6,9)
End DoDot:2
End DoDot:1
+51 ;
+52 IF $GET(IBIFN)
DO PULL399(IBIFN,.BILLRETURN,RETURNREC,EEPULL)
+53 ;
+54 DO SORTSET^IBACCWLSORT1(RETURN,ENCIENS,.BILLRETURN,IBIFN,RETURNREC)
+55 ;
+56 KILL RETURN,ENCIENS
+57 ;
+58 QUIT
+59 ;
PULL399(IBIFN,BILLRETURN,RETURNREC,FULLPULL) ;EP - PULL DATA FROM 399
+1 ;
+2 NEW BILLIENS,ERROR,FIELDS,FLAGS
+3 ;
+4 SET BILLIENS=IBIFN_","
+5 SET FIELDS=".01;.02;.03;.05;.19;.22;11;101;102;151;201;202"
+6 SET FLAGS="ERIN"
+7 ;
+8 IF $GET(FULLPULL)
Begin DoDot:1
+9 SET FLAGS="ERIN"
+10 SET FIELDS="**"
End DoDot:1
+11 ;
+12 DO GETS^DIQ(399,BILLIENS,FIELDS,FLAGS,"BILLRETURN","ERROR")
+13 ;
+14 IF $DATA(ERROR)
Begin DoDot:1
+15 WRITE !!,"Error occurred in file #399 extract. Report to eBilling"
+16 WRITE !,$GET(ERROR("DIERR",1,"TEXT",1))
+17 ;TPF;IB*2*770v47;EBILL-6042
NEW DIR
+18 DO PAUSE^VALM1
End DoDot:1
QUIT
+19 ;
+20 DO GETS^DIQ(399.0304,BILLIENS_"1,","**",FLAGS,"BILLRETURN","ERROR")
+21 ;
+22 QUIT
+23 ;
SETARRAY(LINENUM,VALMCNT) ;EP - NEW SET ARRAY WITH NEW SORT ^TMP("IBACCUTIL",$J,"SORTED" SORTED DATA
+1 ;
+2 NEW ASSIGNEDGRP,BILLIEN,BILLNUM,BILLIENS,CHARGEAMT,CLAIMNUM,CPT,DATAFLAG,DATEASSIGNED,DAYSONWL,DAYSONGRPWL,DIVISION,DIVNAME,DOB,ENCIEN,EXTSERVDATE,FILENUM,FILENUM,FIELDNAME,FIELDVALUEREF,FIRSTDAY,FORMTYPE,GLOREF
+3 NEW OLDIENS,PAIDAMT,PATIEN,PATNOTFOUND,PATTYPE,PAYERCON,PREVACT,PRIDX,PRIMESORT,PRIMINSUR,PROVIDER,PROVNPI,PTIEN,PTNAME,REASCODE,ROOTREF,SECINSUR,SECONDX,SECSORT,SERVCON
+4 ;TPF;IB*2*770v11;EBILL-4507
NEW SORTCOUNT,SORTTYPE,SSN,STATUS,TERTINSUR,TERTSORT,TODAY,VISMARK,X1,X2,X
+5 ;TPF;IB*2*770v11;EBILL-4507
NEW SERVFACNM,SERVFACNPI
+6 ;TPF XINDEX
NEW PRIMDXDESC
+7 ;
+8 SET SORTCOUNT=0
+9 FOR SORTTYPE="K# SORTED","NO K# SORTED"
Begin DoDot:1
+10 ;
+11 SET ROOTREF="^TMP(""IBACCUTIL"","_$JOB_","""_SORTTYPE_""")"
+12 SET OLDIENS="START"
+13 SET GLOREF=ROOTREF
+14 FOR
SET GLOREF=$QUERY(@GLOREF)
if GLOREF=""
QUIT
if $QSUBSCRIPT(GLOREF,3)'=SORTTYPE
QUIT
Begin DoDot:2
+15 ;
+16 IF SORTTYPE="NO K# SORTED"
IF 'SORTCOUNT
Begin DoDot:3
+17 SET SORTCOUNT=1
+18 ;
+19 ;INSERT K# SEPARATOR LINE
+20 IF $DATA(^TMP("IBACCUTIL",$JOB,"K# SORTED"))
Begin DoDot:4
+21 SET LINENUM=LINENUM+1
+22 DO SORTLINE^IBACCWLUTIL(.VALMDDF,LINENUM,.LINE)
+23 DO SET(LINE,.VALMCNT,.LINENUM,$GET(BILLIEN)_U_$GET(ENCIEN),VALMAR)
End DoDot:4
End DoDot:3
+24 ;
+25 SET PRIMESORT=$QSUBSCRIPT(GLOREF,4)
+26 SET SECSORT=$QSUBSCRIPT(GLOREF,5)
+27 SET TERTSORT=$QSUBSCRIPT(GLOREF,6)
+28 SET FILENUM=$QSUBSCRIPT(GLOREF,7)
+29 SET ENCIENS=$QSUBSCRIPT(GLOREF,8)
+30 SET FIELDNAME=$QSUBSCRIPT(GLOREF,9)
+31 SET DATAFLAG=$QSUBSCRIPT(GLOREF,10)
+32 SET X=""
+33 ;
+34 SET ENCIEN=+ENCIENS
+35 if ENCIENS=OLDIENS
QUIT
+36 SET LINENUM=LINENUM+1
+37 SET OLDIENS=ENCIENS
+38 ;
+39 SET FIELDVALUEREF=$NAME(@GLOREF,8)
+40 SET X=$$SETFLD^VALM1(LINENUM,X,"LINENUM")
+41 ;
+42 SET CLAIMNUM=$GET(@FIELDVALUEREF@("X12 CLAIM NUMBER","E"))
+43 SET BILLNUM=CLAIMNUM
+44 SET BILLNUM=$GET(@FIELDVALUEREF@("CLAIM NUMBER","E"))
+45 SET BILLIEN=$GET(@FIELDVALUEREF@("CLAIM NUMBER","I"))
+46 ;
+47 IF $DATA(VALMDDF("BILLNUM"))
Begin DoDot:3
+48 SET CLAIMNUM=$EXTRACT(CLAIMNUM,($LENGTH(CLAIMNUM)-$PIECE(VALMDDF("BILLNUM"),U,3))+1,$LENGTH(CLAIMNUM))
+49 if BILLNUM=""
SET BILLNUM=CLAIMNUM
+50 SET X=$$SETFLD^VALM1(BILLNUM,X,"BILLNUM")
End DoDot:3
+51 ;
+52 SET EXTSERVDATE=$GET(@FIELDVALUEREF@("SERVICE DATE","I"))
+53 SET EXTSERVDATE=$$FMTE^XLFDT(EXTSERVDATE,"2ZD")
+54 IF $DATA(VALMDDF("SERVDATE"))
SET X=$$SETFLD^VALM1(EXTSERVDATE,X,"SERVDATE")
+55 ;
+56 IF $DATA(@FIELDVALUEREF@("PATIENT"))
Begin DoDot:3
+57 SET PTNAME=$GET(@FIELDVALUEREF@("PATIENT","E"))
+58 SET PATIEN=$GET(@FIELDVALUEREF@("PATIENT","I"))
End DoDot:3
+59 ;
+60 IF $GET(PTNAME)=""
Begin DoDot:3
+61 SET PTNAME=$GET(@FIELDVALUEREF@("PATIENT LAST NAME","E"))_", "_$GET(@FIELDVALUEREF@("PATIENT FIRST NAME","E"))_" "_$GET(@FIELDVALUEREF@("PATIENT MIDDLE NAME","E"))
End DoDot:3
+62 SET X=$$SETFLD^VALM1(PTNAME,X,"PTNAME")
+63 ;
+64 ;TPF;IB*2*770v18;EBILL-4623
IF $DATA(VALMDDF("SSN"))
Begin DoDot:3
+65 SET SSN=$GET(@FIELDVALUEREF@("PATIENT SSN","E"))
+66 SET X=$$SETFLD^VALM1(SSN,X,"SSN")
End DoDot:3
+67 ;
+68 SET DOB=$GET(@FIELDVALUEREF@("PATIENT DOB","I"))
+69 SET DOB=$$FMTE^XLFDT(DOB,"2ZD")
+70 IF $DATA(VALMDDF("DOB"))
SET X=$$SETFLD^VALM1(DOB,X,"DOB")
+71 ;
+72 SET CPT=$GET(@FIELDVALUEREF@("CPT","E"))
+73 IF $DATA(VALMDDF("CPT"))
SET X=$$SETFLD^VALM1(CPT,X,"CPT")
+74 ;
+75 ;TPF;IB*2*770v18;EBILL-4623
IF $DATA(VALMDDF("PRIMDX"))
Begin DoDot:3
+76 SET PRIMDX=$GET(@FIELDVALUEREF@("PRIMARY DX","E"))
+77 SET PRIMDXDESC=$$ICDLKUP^IBACCWLUTIL1(PRIMDX)
+78 ;TPF;IB*2*770v20;EBILL-4971
SET PRIMDX=PRIMDXDESC
+79 SET X=$$SETFLD^VALM1(PRIMDX,X,"PRIMDX")
End DoDot:3
+80 ;
+81 ;TPF*IB*2*770v20;EBILL=4928
SET SECONDX=$GET(@FIELDVALUEREF@("SECONDARY DX","E"))
+82 SET SECONDX=$$CONVERT2DEC^IBACCWLUTIL1(SECONDX)
+83 IF $DATA(VALMDDF("SECONDX"))
SET X=$$SETFLD^VALM1(SECONDX,X,"SECONDX")
+84 ;
+85 ;TPF;IB*2*770v18;EBILL-4665
IF $DATA(VALMDDF("PAYERCON"))
Begin DoDot:3
+86 SET PAYERCON=$GET(@FIELDVALUEREF@("PAYER CLAIM CONTROL NUMBER","E"))
+87 SET X=$$SETFLD^VALM1($EXTRACT(PAYERCON,1,$PIECE(VALMDDF("PAYERCON"),U,3)-1),X,"PAYERCON")
End DoDot:3
+88 ;
+89 SET PATTYPE=$PIECE($GET(@FIELDVALUEREF@("IN-PATIENT/OUT-PATIENT","E")),"-")
+90 IF $DATA(VALMDDF("PATTYPE"))
SET X=$$SETFLD^VALM1(PATTYPE,X,"PATTYPE")
+91 ;
+92 SET FORMTYPE=$GET(@FIELDVALUEREF@("FORM TYPE","E"))
+93 SET FORMTYPE=$SELECT(FORMTYPE[("CMS"):$PIECE(FORMTYPE,"-",2),FORMTYPE[("J"):$EXTRACT(FORMTYPE,1,4),1:$TRANSLATE(FORMTYPE,"-"))
+94 IF $DATA(VALMDDF("FORMTYPE"))
SET X=$$SETFLD^VALM1(FORMTYPE,X,"FORMTYPE")
+95 ;
+96 SET PRIMINSUR=$GET(@FIELDVALUEREF@("PRIMARY INS","E"))
+97 IF $DATA(VALMDDF("PRIMINSUR"))
SET X=$$SETFLD^VALM1($EXTRACT(PRIMINSUR,1,$PIECE(VALMDDF("PRIMINSUR"),U,3)-1),X,"PRIMINSUR")
+98 ;
+99 SET SECINSUR=$GET(@FIELDVALUEREF@("SECONDARY INS","E"))
+100 IF $DATA(VALMDDF("SECINSUR"))
SET X=$$SETFLD^VALM1($EXTRACT(SECINSUR,1,$PIECE(VALMDDF("SECINSUR"),U,3)),X,"SECINSUR")
+101 ;
+102 ;NOT USED
SET TERTINSUR=$GET(@FIELDVALUEREF@("TERTIARY INS","E"))
+103 ;
+104 ;TPF;IB*2*770v26;EBILL-5242
+105 IF $GET(PATIEN)
SET SERVCON=$$ISSPECAUTH^IBACCWLUTIL1(PATIEN)
+106 IF '$TEST
SET SERVCON=" / "
+107 IF $DATA(VALMDDF("SERVCON"))
SET X=$$SETFLD^VALM1(SERVCON,X,"SERVCON")
+108 ;
+109 SET PROVIDER=$GET(@FIELDVALUEREF@("PROVIDER","E"))
+110 IF $DATA(VALMDDF("PROVIDER"))
SET X=$$SETFLD^VALM1($EXTRACT(PROVIDER,1,$PIECE(VALMDDF("PROVIDER"),U,3)),X,"PROVIDER")
+111 ;
+112 SET PROVNPI=$GET(@FIELDVALUEREF@("PROVIDER NPI","E"))
+113 ;TPF;IB*2*770v11;EBILL-4509
IF $DATA(VALMDDF("PROVNPI"))
SET X=$$SETFLD^VALM1(PROVNPI,X,"PROVNPI")
+114 ;
+115 SET REASCODE=$GET(@FIELDVALUEREF@("REASONS","E"))
+116 ;TPF;IB*2*770v8;EBILL-4439
IF $DATA(VALMDDF("REASCODE"))
SET X=$$SETFLD^VALM1($EXTRACT(REASCODE,1,$PIECE(VALMDDF("REASCODE"),U,3)-1),X,"REASCODE")
+117 ;
+118 ;TPF;IB*2*770v14;EBILL-4574
SET DAYSONGRPWL=$JUSTIFY($GET(@FIELDVALUEREF@("DAYS ON GROUP WORKLIST","E")),4)
+119 IF $DATA(VALMDDF("DAYSONGRPWL"))
SET X=$$SETFLD^VALM1(DAYSONGRPWL,X,"DAYSONGRPWL")
+120 ;
+121 ;NEW SPECS ;TPF;IB*2*770v11;EBILL-4507
+122 ;TPF;IB*2*770v11;EBILL-4507
SET SERVFACNM=$GET(@FIELDVALUEREF@("SERVICE FACILITY","E"))
+123 ;TPF;IB*2*770v11;EBILL-4507
IF $DATA(VALMDDF("SERVFACNM"))
SET X=$$SETFLD^VALM1(SERVFACNM,X,"SERVFACNM")
+124 ;
+125 ;TPF;IB*2*770v11;EBILL-4507
SET SERVFACNPI=$GET(@FIELDVALUEREF@("SERVICE FACILITY NPI","E"))
+126 ;TPF;IB*2*770v11;EBILL-4507
IF $DATA(VALMDDF("FACNPI"))
SET X=$$SETFLD^VALM1(SERVFACNPI,X,"FACNPI")
+127 ;
+128 ;TPF;IB*2*770v18;EBILL-4623
IF $DATA(VALMDDF("DIVNAME"))
Begin DoDot:3
+129 SET (DIVNAME,DIVISION)=$GET(@FIELDVALUEREF@("SITE NUMBER","E"))
+130 if DIVISION
SET DIVISION=$$LKUP^XUAF4(DIVISION)
+131 IF DIVISION
SET DIVNAME=$$GET1^DIQ(4,DIVISION_",",.01,"E")
+132 SET X=$$SETFLD^VALM1(DIVNAME,X,"DIVNAME")
End DoDot:3
+133 ;
+134 ;TPF;IB*2*770v18;EBILL-4623
SET PAIDAMT=$GET(@FIELDVALUEREF@("PAID AMOUNT","E"))
+135 IF $DATA(VALMDDF("PAIDAMT"))
IF PAIDAMT
Begin DoDot:3
+136 SET PAIDAMT=$FNUMBER(PAIDAMT,",",2)
+137 SET PAIDAMT=$JUSTIFY(PAIDAMT,$PIECE(VALMDDF("PAIDAMT"),U,3))
+138 ;TPF;IB*2*770v18;EBILL-4623
SET X=$$SETFLD^VALM1(PAIDAMT,X,"PAIDAMT")
End DoDot:3
+139 ;
+140 ;TPF;IB*2*770v18;EBILL-4623
SET CHARGEAMT=$GET(@FIELDVALUEREF@("CHARGE AMOUNT","E"))
+141 ;TPF;IB*2*770v18;EBILL-4623
IF $DATA(VALMDDF("CHARGEAMT"))
SET X=$$SETFLD^VALM1(CHARGEAMT,X,"CHARGEAMT")
+142 ;
+143 SET ASSIGNEDGRP=$GET(@FIELDVALUEREF@("ASSIGNED TO GROUP","I"))
+144 IF $DATA(VALMDDF("ASSIGNEDGRP"))
SET X=$$SETFLD^VALM1(ASSIGNEDGRP,X,"ASSIGNEDGRP")
+145 ;
+146 SET DATEASSIGNED=$GET(@FIELDVALUEREF@("DATE ASSIGNED","I"))
+147 SET DATEASSIGNED=$$FMTE^XLFDT(DATEASSIGNED,"2ZD")
+148 IF $DATA(VALMDDF("DATEASSNED"))
SET X=$$SETFLD^VALM1(DATEASSIGNED,X,"DATEASSNED")
+149 ;
+150 SET PREVACT=$GET(@FIELDVALUEREF@("PREVACT","E"))
+151 IF $DATA(VALMDDF("PREVACT"))
SET X=$$SETFLD^VALM1(PREVACT,X,"PREVACT")
+152 ;
+153 ;TPF;IB*2*770v15;EBILL-4611
SET PATNOTFOUND=($PIECE($GET(^IBA(364.9,+ENCIENS,2)),U)="")
+154 SET STATUS=$GET(@FIELDVALUEREF@("STATUS","I"))
+155 SET VISMARK=$SELECT(PATNOTFOUND:"!",1:"")
+156 ;* = 'IN PROGRESS' ! = PAT NOT IN #200
SET VISMARK=VISMARK_$SELECT(STATUS=1:"*",1:"")
+157 IF $DATA(VALMDDF("INDICATOR"))
SET X=$$SETFLD^VALM1(VISMARK,X,"INDICATOR")
+158 ;
+159 DO SET(X,.VALMCNT,.LINENUM,BILLIEN_U_ENCIEN,VALMAR)
+160 ;
End DoDot:2
End DoDot:1
+161 ;
+162 QUIT
+163 ;
NODATA(TEXT,RECORDNUM) ;EP - DISPLAY ERROR IN LM DISPLAY WINDOW
+1 NEW DATA,DATAIEN
+2 MERGE DATA=TEXT
+3 SET RECORD=""
+4 SET X=""
+5 ;
+6 ;EMPTY LINE
SET RECORDNUM=RECORDNUM+1
+7 DO SET("",.VALMCNT,.RECORDNUM,"",VALMAR)
+8 ;
+9 SET DATAIEN=0
+10 FOR
SET DATAIEN=$ORDER(DATA(DATAIEN))
if DATAIEN=""
QUIT
Begin DoDot:1
+11 SET RECORDNUM=RECORDNUM+1
+12 SET RECORD=$$SETFLD^VALM1(DATA(DATAIEN),RECORD,"PTNAME")
+13 DO SET(RECORD,.VALMCNT,.RECORDNUM,"",VALMAR)
End DoDot:1
+14 ;
+15 SET RECORDNUM=RECORDNUM+1
+16 DO SET("",.VALMCNT,.RECORDNUM,"",VALMAR)
+17 ;
+18 QUIT
