IBCIL0 ;DSI/ESG - CLAIMSMANAGER SKIP LIST ;11-JAN-2001
;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;The skip list is a routine that will allow system managers the
;capabilities to select transactions that errored due to system
;failures. This routine utilizes ListMan functions.
EN ; -- main entry point for IBCI CLAIMSMANAGER SKIP LIST
;
; Try to get an option-level lock
L +^IBCIL0:0
E W @IOF,!!!?10,"Another user is currently using this option.",!!?10,"Please try again later.",!! S DIR(0)="E" D ^DIR K DIR Q
;
I '$$CK2^IBCIUT1 D Q ; check to see that ClaimsManager working OK
. W @IOF,!!!?10,"ClaimsManager is not working right now."
. W !!?10,"Please try again later.",!!
. S DIR(0)="E" D ^DIR K DIR
. L -^IBCIL0
. Q
;
D EN^VALM("IBCI CLAIMSMANAGER SKIP LIST")
KILL ^TMP("IBCIL0",$J),^TMP("IBCIL1",$J),^TMP("IBCIL2",$J)
KILL IBCISTAT,IBCISNT,IBCIREDT,IBCIERR,CT
L -^IBCIL0
Q
;
HDR ; -- header code
S VALMHDR(1)=" Welcome to ClaimsManager Bill Processing"
S VALMHDR(2)=" This ListMan will display all skipped bills for processing"
Q
;
INIT ; -- init variables and list array
D CLEAN^VALM10
K ^TMP("IBCIL0",$J),^TMP("IBCIL1",$J),^TMP("IBCIL2",$J),CT
NEW IBCIVAUS,IBCIFDAT,IBCIIEN,IBCIBNUM
NEW IBCINAME,IBCIDATE,IBCIUSER,IBCIST0,IBCIST1,IBCIARR
NEW IBCISKST,NODE0,IBCIDFN,IBCIXX
S IBCIARR=""
F IBCISKST=2,6,7,10,11 D
.S IBCIIEN=0 F S IBCIIEN=$O(^IBA(351.9,"AST",IBCISKST,IBCIIEN)) Q:'IBCIIEN D
..S NODE0=^IBA(351.9,IBCIIEN,0)
..S IBCIBNUM=$P(^DGCR(399,IBCIIEN,0),U,1)
..S IBCIFDAT=$P($P(^DGCR(399,IBCIIEN,0),U,3),".",1)
..S IBCIDATE=$$FDATE^VALM1(IBCIFDAT)
..S IBCIUSER=$P(NODE0,U,12) ; assigned to peep
..I 'IBCIUSER S IBCIUSER=+$$BILLER^IBCIUT5(IBCIIEN) ; biller
..I 'IBCIUSER S IBCIUSER=$P(NODE0,U,9) ; last edited by
..I 'IBCIUSER S IBCIUSER=$P(NODE0,U,7) ; entered by
..S IBCIVAUS=$P($G(^VA(200,IBCIUSER,0)),U,1)
..I IBCIVAUS="" S IBCIVAUS="UNKNOWN"
..S IBCIDFN=$P(^DGCR(399,IBCIIEN,0),U,2)
..S IBCINAME=$P($G(^DPT(IBCIDFN,0)),U,1)
..S IBCIST0=$P(^DGCR(399,IBCIIEN,0),U,13)
..I IBCIST0=1 S IBCIST1="E/NR"
..I IBCIST0=2 S IBCIST1="R/MRA"
..I IBCIST0=3 S IBCIST1="AUTH"
..I IBCIST0=4 S IBCIST1="PR/TX"
..I IBCIST0=7 S IBCIST1="CANX"
..I IBCIST0=0 S IBCIST1="CLSD",IBCIST0=9
..S ^TMP("IBCIL0",$J,IBCIST0,IBCIVAUS,IBCIBNUM)=IBCIIEN_U_IBCIST1_U_IBCIVAUS_U_IBCIBNUM_U_IBCINAME_U_IBCIDATE
SRT ;sort
S (IBCIST0,CT)=0 F S IBCIST0=$O(^TMP("IBCIL0",$J,IBCIST0)) Q:'IBCIST0 D
.S IBCIUSER="" F S IBCIUSER=$O(^TMP("IBCIL0",$J,IBCIST0,IBCIUSER)) Q:IBCIUSER="" D
..S IBCIBNUM="" F S IBCIBNUM=$O(^TMP("IBCIL0",$J,IBCIST0,IBCIUSER,IBCIBNUM)) Q:IBCIBNUM="" D
...S IBCIXX=^TMP("IBCIL0",$J,IBCIST0,IBCIUSER,IBCIBNUM)
...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,2),IBCIARR,"STATUS")
...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,3),IBCIARR,"USER")
...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,4),IBCIARR,"BNUM")
...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,5),IBCIARR,"PT_NAME")
...S IBCIARR=$$SETFLD^VALM1($P(IBCIXX,U,6),IBCIARR,"EVENT_DATE")
...S CT=CT+1
...S ^TMP("IBCIL1",$J,CT)=$P(IBCIXX,U)_U_$P(^IBA(351.9,$P(IBCIXX,U),0),U,2)_U_IBCIST0
...S IBCIARR=$$SETFLD^VALM1(CT,IBCIARR,"ITEM") D SET^VALM10(CT,IBCIARR)
S VALMCNT=CT
I VALMCNT=0 S VALMSG="No Skipped Claims to Send to ClaimsManager."
D EXIT
Q
;
SELB ; select single bill, bill by status, or multiple range of bills
;
NEW IBCIENAR,IBCINUMS,IBCIPIEC,IBCIYSUB,IBCIX
S VALMBCK="R"
I CT=0 D NOBILS,INIT G SELBX
D FULL^VALM1
S DIR(0)="LO^1:"_CT
S DIR("A",1)="You may select one or more claims, or a range."
S DIR("A")="Selection"
S DIR("?",1)=" You may choose a single bill, a list of bills (i.e. 2,5,9,12), a range"
S DIR("?",2)=" of bills (i.e. 3-8), or any combination of these (i.e. 1,3,5,8-12). Only"
S DIR("?")=" the bills you select here will be sent to ClaimsManager."
D ^DIR K DIR
I $D(DIRUT) G SELBX
D YESBLS
M IBCIENAR=Y KILL X,Y
S IBCIYSUB=""
F S IBCIYSUB=$O(IBCIENAR(IBCIYSUB)) Q:IBCIYSUB="" D
. S IBCINUMS=IBCIENAR(IBCIYSUB)
. S IBCINUMS=$E(IBCINUMS,1,$L(IBCINUMS)-1)
. F IBCIPIEC=1:1:$L(IBCINUMS,",") S IBCIX=$P(IBCINUMS,",",IBCIPIEC) D N1
. Q
D SENDMAIL,INIT
SELBX ;
Q
;
N1 ; check for valid number and send the claim
NEW IBCIST1,IBIFN,IBCIMCSB,IBCIMCSL
NEW ATP,BILLNO,CHARGES,DFN,DPTDATA,EVENTDT,IBDATA,PATNAME,RESP,RESPNM
NEW SSN,TMPDATA
NEW IBCIENAR,IBCINUMS,IBCIPIEC,IBCIYSUB
;
I 'IBCIX Q
I '$D(^TMP("IBCIL1",$J,IBCIX)) Q
S IBIFN=$P(^TMP("IBCIL1",$J,IBCIX),U,1)
S IBCIST1=$P(^TMP("IBCIL1",$J,IBCIX),U,3) D STATUS
;
S IBCIMCSB=+$$BILLER^IBCIUT5(IBIFN) ; current biller
S IBCIMCSL=+$P($G(^IBA(351.9,IBIFN,0)),U,5) ; last sent to CM by
;
D ST2^IBCIST ; send a single bill to CM
W "."
;
; esg - 10/4/01 - If the bill is still editable and it came back
; clean from CM, then build a scratch global so we can send
; a MailMan message to some people about this.
;
I IBCISNT=2,IBCISTAT=3 D
. S (RESP,ATP)=+$P($G(^IBA(351.9,IBIFN,0)),U,12)
. I 'RESP S RESP=IBCIMCSB
. I 'RESP S RESP=DUZ
. S RESPNM=$P($G(^VA(200,RESP,0)),U,1)
. I RESPNM="" S RESPNM="UNKNOWN"
. S CHARGES=+$P($G(^DGCR(399,IBIFN,"U1")),U,1)
. S IBDATA=$G(^DGCR(399,IBIFN,0))
. S BILLNO=$P(IBDATA,U,1)
. S DFN=+$P(IBDATA,U,2)
. S DPTDATA=$G(^DPT(DFN,0))
. S SSN=$E($P(DPTDATA,U,9),6,9)
. S PATNAME=$P(DPTDATA,U,1)
. S EVENTDT=$P($P(IBDATA,U,3),".",1)
. S TMPDATA=BILLNO_U_PATNAME_U_SSN_U_EVENTDT
. S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN)=TMPDATA
. ;
. ; these people should get the MailMan message
. I ATP S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN,ATP)=""
. I IBCIMCSB S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN,IBCIMCSB)=""
. I IBCIMCSL S ^TMP("IBCIL2",$J,RESPNM,-CHARGES,IBIFN,IBCIMCSL)=""
. S ^TMP("IBCIL2",$J)=$G(^TMP("IBCIL2",$J))+1
. Q
Q
;
STATUS ;set ibcisnt based on criteria
K IBCISNT
I $$STAT^IBCIUT1(IBIFN)=10 S IBCISNT=4 Q
I $$STAT^IBCIUT1(IBIFN)=11 S IBCISNT=5 Q
S IBCISNT=$S("^1^"[IBCIST1:2,1:6)
Q
;
ALL ;send all claims
NEW IBCIX
S VALMBCK="R"
I CT=0 D NOBILS,INIT Q
I CT>0 D YESBLS
S IBCIX=0 F S IBCIX=$O(^TMP("IBCIL1",$J,IBCIX)) Q:'IBCIX D N1
D SENDMAIL,INIT
Q
SNA ;send all non authorized claims
NEW IBCIX
S VALMBCK="R"
I CT=0 D NOBILS,INIT Q
I CT>0 D YESBLS
S IBCIX=0 F S IBCIX=$O(^TMP("IBCIL1",$J,IBCIX)) Q:'IBCIX D
. I $P(^TMP("IBCIL1",$J,IBCIX),U,3)<3 D N1
. Q
D SENDMAIL,INIT
Q
;
SENDMAIL ;
; This procedure is responsible for sending a MailMan message to
; users about the claims that had no ClaimsManager errors. The
; message will list all clean claims and will be sent to the billers,
; assigned to people, current user, and the user who most recently
; sent the bill to CM.
;
NEW CHG,IBIFN,L1,TEXT,TMPDATA,USER,XMDUZ,XMSUB,XMTEXT,XMY,XMDUN,XMZ
NEW X,Y,X1,X2,X3,X4
I '$D(^TMP("IBCIL2",$J)) G SENDX
S L1=1
S TEXT(L1)="The following bills were sent to ClaimsManager from the Multiple Claim Send",L1=L1+1
S TEXT(L1)="option. ClaimsManager did not find any errors with them. These bills have",L1=L1+1
S TEXT(L1)="passed both the IB edit checks and the ClaimsManager edit checks. They are",L1=L1+1
S TEXT(L1)="ready to be authorized. Please review the bills for which you are responsible",L1=L1+1
S TEXT(L1)="(if any) and take the appropriate action.",L1=L1+1
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)=$J("EVENT",43),L1=L1+1
S TEXT(L1)=" BILL# PATIENT NAME PID DATE CHARGES USER NAME",L1=L1+1
S TEXT(L1)=" ------- ------------------ ---- ---------- ---------- ------------------",L1=L1+1
;
S USER=""
F S USER=$O(^TMP("IBCIL2",$J,USER)) Q:USER="" S CHG="" F S CHG=$O(^TMP("IBCIL2",$J,USER,CHG)) Q:CHG="" S IBIFN=0 F S IBIFN=$O(^TMP("IBCIL2",$J,USER,CHG,IBIFN)) Q:'IBIFN D
. M XMY=^TMP("IBCIL2",$J,USER,CHG,IBIFN)
. S TMPDATA=XMY,XMY=""
. S TEXT(L1)=" "
. S X=$P(TMPDATA,U,1),X1=7,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S TEXT(L1)=TEXT(L1)_" "
. S X=$P(TMPDATA,U,2),X1=18,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S X=$P(TMPDATA,U,3),X1=6,X2="R" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S X=$$FMTE^XLFDT($P(TMPDATA,U,4),"5Z"),X1=12,X2="R"
. S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S X="$"_$FN(-CHG,",",2),X1=12,X2="R"
. S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S TEXT(L1)=TEXT(L1)_" "
. S X=USER,X1=18,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
. S L1=L1+1
. Q
S TEXT(L1)=" ",L1=L1+1
S TEXT(L1)=" ",L1=L1+1
;
S XMTEXT="TEXT("
S XMDUZ=DUZ
S XMSUB="ClaimsManager Clean Claims"
S XMY(DUZ)=""
D ^XMD
SENDX ;
Q
;
NOBILS ;msg for no bills
D FULL^VALM1
W !!,"There are no claims to send ...",!
S DIR(0)="E" D ^DIR K DIR
Q
YESBLS ;msg for sending bills
W !!,"Sending claims ... please wait.",!
Q
HELP ; -- help code
S X="?"
D FULL^VALM1
D EN^DDIOL(" 'Send All Bills to ClaimsManager' will send all claims listed","","!!")
D EN^DDIOL(" to ClaimsManager for processing.")
D EN^DDIOL(" 'Send All Non Auth Bills to ClaimsManager' will send only","","!!")
D EN^DDIOL(" Non-Authorized claims to ClaimsManager for processing.")
D EN^DDIOL(" 'Select Bills to send to ClaimsManager' allows individual and","","!!")
D EN^DDIOL(" multiple selection of claims before sending")
D EN^DDIOL(" claims to ClaimsManager for processing.")
D PAUSE^VALM1
S VALMBCK="R"
Q
;
EXIT ; -- exit code
D CLEAR^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIL0 9640 printed Dec 13, 2024@02:13:17 Page 2
IBCIL0 ;DSI/ESG - CLAIMSMANAGER SKIP LIST ;11-JAN-2001
+1 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;The skip list is a routine that will allow system managers the
+5 ;capabilities to select transactions that errored due to system
+6 ;failures. This routine utilizes ListMan functions.
EN ; -- main entry point for IBCI CLAIMSMANAGER SKIP LIST
+1 ;
+2 ; Try to get an option-level lock
+3 LOCK +^IBCIL0:0
+4 IF '$TEST
WRITE @IOF,!!!?10,"Another user is currently using this option.",!!?10,"Please try again later.",!!
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+5 ;
+6 ; check to see that ClaimsManager working OK
IF '$$CK2^IBCIUT1
Begin DoDot:1
+7 WRITE @IOF,!!!?10,"ClaimsManager is not working right now."
+8 WRITE !!?10,"Please try again later.",!!
+9 SET DIR(0)="E"
DO ^DIR
KILL DIR
+10 LOCK -^IBCIL0
+11 QUIT
End DoDot:1
QUIT
+12 ;
+13 DO EN^VALM("IBCI CLAIMSMANAGER SKIP LIST")
+14 KILL ^TMP("IBCIL0",$JOB),^TMP("IBCIL1",$JOB),^TMP("IBCIL2",$JOB)
+15 KILL IBCISTAT,IBCISNT,IBCIREDT,IBCIERR,CT
+16 LOCK -^IBCIL0
+17 QUIT
+18 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" Welcome to ClaimsManager Bill Processing"
+2 SET VALMHDR(2)=" This ListMan will display all skipped bills for processing"
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 DO CLEAN^VALM10
+2 KILL ^TMP("IBCIL0",$JOB),^TMP("IBCIL1",$JOB),^TMP("IBCIL2",$JOB),CT
+3 NEW IBCIVAUS,IBCIFDAT,IBCIIEN,IBCIBNUM
+4 NEW IBCINAME,IBCIDATE,IBCIUSER,IBCIST0,IBCIST1,IBCIARR
+5 NEW IBCISKST,NODE0,IBCIDFN,IBCIXX
+6 SET IBCIARR=""
+7 FOR IBCISKST=2,6,7,10,11
Begin DoDot:1
+8 SET IBCIIEN=0
FOR
SET IBCIIEN=$ORDER(^IBA(351.9,"AST",IBCISKST,IBCIIEN))
if 'IBCIIEN
QUIT
Begin DoDot:2
+9 SET NODE0=^IBA(351.9,IBCIIEN,0)
+10 SET IBCIBNUM=$PIECE(^DGCR(399,IBCIIEN,0),U,1)
+11 SET IBCIFDAT=$PIECE($PIECE(^DGCR(399,IBCIIEN,0),U,3),".",1)
+12 SET IBCIDATE=$$FDATE^VALM1(IBCIFDAT)
+13 ; assigned to peep
SET IBCIUSER=$PIECE(NODE0,U,12)
+14 ; biller
IF 'IBCIUSER
SET IBCIUSER=+$$BILLER^IBCIUT5(IBCIIEN)
+15 ; last edited by
IF 'IBCIUSER
SET IBCIUSER=$PIECE(NODE0,U,9)
+16 ; entered by
IF 'IBCIUSER
SET IBCIUSER=$PIECE(NODE0,U,7)
+17 SET IBCIVAUS=$PIECE($GET(^VA(200,IBCIUSER,0)),U,1)
+18 IF IBCIVAUS=""
SET IBCIVAUS="UNKNOWN"
+19 SET IBCIDFN=$PIECE(^DGCR(399,IBCIIEN,0),U,2)
+20 SET IBCINAME=$PIECE($GET(^DPT(IBCIDFN,0)),U,1)
+21 SET IBCIST0=$PIECE(^DGCR(399,IBCIIEN,0),U,13)
+22 IF IBCIST0=1
SET IBCIST1="E/NR"
+23 IF IBCIST0=2
SET IBCIST1="R/MRA"
+24 IF IBCIST0=3
SET IBCIST1="AUTH"
+25 IF IBCIST0=4
SET IBCIST1="PR/TX"
+26 IF IBCIST0=7
SET IBCIST1="CANX"
+27 IF IBCIST0=0
SET IBCIST1="CLSD"
SET IBCIST0=9
+28 SET ^TMP("IBCIL0",$JOB,IBCIST0,IBCIVAUS,IBCIBNUM)=IBCIIEN_U_IBCIST1_U_IBCIVAUS_U_IBCIBNUM_U_IBCINAME_U_IBCIDATE
End DoDot:2
End DoDot:1
SRT ;sort
+1 SET (IBCIST0,CT)=0
FOR
SET IBCIST0=$ORDER(^TMP("IBCIL0",$JOB,IBCIST0))
if 'IBCIST0
QUIT
Begin DoDot:1
+2 SET IBCIUSER=""
FOR
SET IBCIUSER=$ORDER(^TMP("IBCIL0",$JOB,IBCIST0,IBCIUSER))
if IBCIUSER=""
QUIT
Begin DoDot:2
+3 SET IBCIBNUM=""
FOR
SET IBCIBNUM=$ORDER(^TMP("IBCIL0",$JOB,IBCIST0,IBCIUSER,IBCIBNUM))
if IBCIBNUM=""
QUIT
Begin DoDot:3
+4 SET IBCIXX=^TMP("IBCIL0",$JOB,IBCIST0,IBCIUSER,IBCIBNUM)
+5 SET IBCIARR=$$SETFLD^VALM1($PIECE(IBCIXX,U,2),IBCIARR,"STATUS")
+6 SET IBCIARR=$$SETFLD^VALM1($PIECE(IBCIXX,U,3),IBCIARR,"USER")
+7 SET IBCIARR=$$SETFLD^VALM1($PIECE(IBCIXX,U,4),IBCIARR,"BNUM")
+8 SET IBCIARR=$$SETFLD^VALM1($PIECE(IBCIXX,U,5),IBCIARR,"PT_NAME")
+9 SET IBCIARR=$$SETFLD^VALM1($PIECE(IBCIXX,U,6),IBCIARR,"EVENT_DATE")
+10 SET CT=CT+1
+11 SET ^TMP("IBCIL1",$JOB,CT)=$PIECE(IBCIXX,U)_U_$PIECE(^IBA(351.9,$PIECE(IBCIXX,U),0),U,2)_U_IBCIST0
+12 SET IBCIARR=$$SETFLD^VALM1(CT,IBCIARR,"ITEM")
DO SET^VALM10(CT,IBCIARR)
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET VALMCNT=CT
+14 IF VALMCNT=0
SET VALMSG="No Skipped Claims to Send to ClaimsManager."
+15 DO EXIT
+16 QUIT
+17 ;
SELB ; select single bill, bill by status, or multiple range of bills
+1 ;
+2 NEW IBCIENAR,IBCINUMS,IBCIPIEC,IBCIYSUB,IBCIX
+3 SET VALMBCK="R"
+4 IF CT=0
DO NOBILS
DO INIT
GOTO SELBX
+5 DO FULL^VALM1
+6 SET DIR(0)="LO^1:"_CT
+7 SET DIR("A",1)="You may select one or more claims, or a range."
+8 SET DIR("A")="Selection"
+9 SET DIR("?",1)=" You may choose a single bill, a list of bills (i.e. 2,5,9,12), a range"
+10 SET DIR("?",2)=" of bills (i.e. 3-8), or any combination of these (i.e. 1,3,5,8-12). Only"
+11 SET DIR("?")=" the bills you select here will be sent to ClaimsManager."
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
GOTO SELBX
+14 DO YESBLS
+15 MERGE IBCIENAR=Y
KILL X,Y
+16 SET IBCIYSUB=""
+17 FOR
SET IBCIYSUB=$ORDER(IBCIENAR(IBCIYSUB))
if IBCIYSUB=""
QUIT
Begin DoDot:1
+18 SET IBCINUMS=IBCIENAR(IBCIYSUB)
+19 SET IBCINUMS=$EXTRACT(IBCINUMS,1,$LENGTH(IBCINUMS)-1)
+20 FOR IBCIPIEC=1:1:$LENGTH(IBCINUMS,",")
SET IBCIX=$PIECE(IBCINUMS,",",IBCIPIEC)
DO N1
+21 QUIT
End DoDot:1
+22 DO SENDMAIL
DO INIT
SELBX ;
+1 QUIT
+2 ;
N1 ; check for valid number and send the claim
+1 NEW IBCIST1,IBIFN,IBCIMCSB,IBCIMCSL
+2 NEW ATP,BILLNO,CHARGES,DFN,DPTDATA,EVENTDT,IBDATA,PATNAME,RESP,RESPNM
+3 NEW SSN,TMPDATA
+4 NEW IBCIENAR,IBCINUMS,IBCIPIEC,IBCIYSUB
+5 ;
+6 IF 'IBCIX
QUIT
+7 IF '$DATA(^TMP("IBCIL1",$JOB,IBCIX))
QUIT
+8 SET IBIFN=$PIECE(^TMP("IBCIL1",$JOB,IBCIX),U,1)
+9 SET IBCIST1=$PIECE(^TMP("IBCIL1",$JOB,IBCIX),U,3)
DO STATUS
+10 ;
+11 ; current biller
SET IBCIMCSB=+$$BILLER^IBCIUT5(IBIFN)
+12 ; last sent to CM by
SET IBCIMCSL=+$PIECE($GET(^IBA(351.9,IBIFN,0)),U,5)
+13 ;
+14 ; send a single bill to CM
DO ST2^IBCIST
+15 WRITE "."
+16 ;
+17 ; esg - 10/4/01 - If the bill is still editable and it came back
+18 ; clean from CM, then build a scratch global so we can send
+19 ; a MailMan message to some people about this.
+20 ;
+21 IF IBCISNT=2
IF IBCISTAT=3
Begin DoDot:1
+22 SET (RESP,ATP)=+$PIECE($GET(^IBA(351.9,IBIFN,0)),U,12)
+23 IF 'RESP
SET RESP=IBCIMCSB
+24 IF 'RESP
SET RESP=DUZ
+25 SET RESPNM=$PIECE($GET(^VA(200,RESP,0)),U,1)
+26 IF RESPNM=""
SET RESPNM="UNKNOWN"
+27 SET CHARGES=+$PIECE($GET(^DGCR(399,IBIFN,"U1")),U,1)
+28 SET IBDATA=$GET(^DGCR(399,IBIFN,0))
+29 SET BILLNO=$PIECE(IBDATA,U,1)
+30 SET DFN=+$PIECE(IBDATA,U,2)
+31 SET DPTDATA=$GET(^DPT(DFN,0))
+32 SET SSN=$EXTRACT($PIECE(DPTDATA,U,9),6,9)
+33 SET PATNAME=$PIECE(DPTDATA,U,1)
+34 SET EVENTDT=$PIECE($PIECE(IBDATA,U,3),".",1)
+35 SET TMPDATA=BILLNO_U_PATNAME_U_SSN_U_EVENTDT
+36 SET ^TMP("IBCIL2",$JOB,RESPNM,-CHARGES,IBIFN)=TMPDATA
+37 ;
+38 ; these people should get the MailMan message
+39 IF ATP
SET ^TMP("IBCIL2",$JOB,RESPNM,-CHARGES,IBIFN,ATP)=""
+40 IF IBCIMCSB
SET ^TMP("IBCIL2",$JOB,RESPNM,-CHARGES,IBIFN,IBCIMCSB)=""
+41 IF IBCIMCSL
SET ^TMP("IBCIL2",$JOB,RESPNM,-CHARGES,IBIFN,IBCIMCSL)=""
+42 SET ^TMP("IBCIL2",$JOB)=$GET(^TMP("IBCIL2",$JOB))+1
+43 QUIT
End DoDot:1
+44 QUIT
+45 ;
STATUS ;set ibcisnt based on criteria
+1 KILL IBCISNT
+2 IF $$STAT^IBCIUT1(IBIFN)=10
SET IBCISNT=4
QUIT
+3 IF $$STAT^IBCIUT1(IBIFN)=11
SET IBCISNT=5
QUIT
+4 SET IBCISNT=$SELECT("^1^"[IBCIST1:2,1:6)
+5 QUIT
+6 ;
ALL ;send all claims
+1 NEW IBCIX
+2 SET VALMBCK="R"
+3 IF CT=0
DO NOBILS
DO INIT
QUIT
+4 IF CT>0
DO YESBLS
+5 SET IBCIX=0
FOR
SET IBCIX=$ORDER(^TMP("IBCIL1",$JOB,IBCIX))
if 'IBCIX
QUIT
DO N1
+6 DO SENDMAIL
DO INIT
+7 QUIT
SNA ;send all non authorized claims
+1 NEW IBCIX
+2 SET VALMBCK="R"
+3 IF CT=0
DO NOBILS
DO INIT
QUIT
+4 IF CT>0
DO YESBLS
+5 SET IBCIX=0
FOR
SET IBCIX=$ORDER(^TMP("IBCIL1",$JOB,IBCIX))
if 'IBCIX
QUIT
Begin DoDot:1
+6 IF $PIECE(^TMP("IBCIL1",$JOB,IBCIX),U,3)<3
DO N1
+7 QUIT
End DoDot:1
+8 DO SENDMAIL
DO INIT
+9 QUIT
+10 ;
SENDMAIL ;
+1 ; This procedure is responsible for sending a MailMan message to
+2 ; users about the claims that had no ClaimsManager errors. The
+3 ; message will list all clean claims and will be sent to the billers,
+4 ; assigned to people, current user, and the user who most recently
+5 ; sent the bill to CM.
+6 ;
+7 NEW CHG,IBIFN,L1,TEXT,TMPDATA,USER,XMDUZ,XMSUB,XMTEXT,XMY,XMDUN,XMZ
+8 NEW X,Y,X1,X2,X3,X4
+9 IF '$DATA(^TMP("IBCIL2",$JOB))
GOTO SENDX
+10 SET L1=1
+11 SET TEXT(L1)="The following bills were sent to ClaimsManager from the Multiple Claim Send"
SET L1=L1+1
+12 SET TEXT(L1)="option. ClaimsManager did not find any errors with them. These bills have"
SET L1=L1+1
+13 SET TEXT(L1)="passed both the IB edit checks and the ClaimsManager edit checks. They are"
SET L1=L1+1
+14 SET TEXT(L1)="ready to be authorized. Please review the bills for which you are responsible"
SET L1=L1+1
+15 SET TEXT(L1)="(if any) and take the appropriate action."
SET L1=L1+1
+16 SET TEXT(L1)=" "
SET L1=L1+1
+17 SET TEXT(L1)=$JUSTIFY("EVENT",43)
SET L1=L1+1
+18 SET TEXT(L1)=" BILL# PATIENT NAME PID DATE CHARGES USER NAME"
SET L1=L1+1
+19 SET TEXT(L1)=" ------- ------------------ ---- ---------- ---------- ------------------"
SET L1=L1+1
+20 ;
+21 SET USER=""
+22 FOR
SET USER=$ORDER(^TMP("IBCIL2",$JOB,USER))
if USER=""
QUIT
SET CHG=""
FOR
SET CHG=$ORDER(^TMP("IBCIL2",$JOB,USER,CHG))
if CHG=""
QUIT
SET IBIFN=0
FOR
SET IBIFN=$ORDER(^TMP("IBCIL2",$JOB,USER,CHG,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+23 MERGE XMY=^TMP("IBCIL2",$JOB,USER,CHG,IBIFN)
+24 SET TMPDATA=XMY
SET XMY=""
+25 SET TEXT(L1)=" "
+26 SET X=$PIECE(TMPDATA,U,1)
SET X1=7
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+27 SET TEXT(L1)=TEXT(L1)_" "
+28 SET X=$PIECE(TMPDATA,U,2)
SET X1=18
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+29 SET X=$PIECE(TMPDATA,U,3)
SET X1=6
SET X2="R"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+30 SET X=$$FMTE^XLFDT($PIECE(TMPDATA,U,4),"5Z")
SET X1=12
SET X2="R"
+31 SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+32 SET X="$"_$FNUMBER(-CHG,",",2)
SET X1=12
SET X2="R"
+33 SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+34 SET TEXT(L1)=TEXT(L1)_" "
+35 SET X=USER
SET X1=18
SET X2="L"
SET TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
+36 SET L1=L1+1
+37 QUIT
End DoDot:1
+38 SET TEXT(L1)=" "
SET L1=L1+1
+39 SET TEXT(L1)=" "
SET L1=L1+1
+40 ;
+41 SET XMTEXT="TEXT("
+42 SET XMDUZ=DUZ
+43 SET XMSUB="ClaimsManager Clean Claims"
+44 SET XMY(DUZ)=""
+45 DO ^XMD
SENDX ;
+1 QUIT
+2 ;
NOBILS ;msg for no bills
+1 DO FULL^VALM1
+2 WRITE !!,"There are no claims to send ...",!
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 QUIT
YESBLS ;msg for sending bills
+1 WRITE !!,"Sending claims ... please wait.",!
+2 QUIT
HELP ; -- help code
+1 SET X="?"
+2 DO FULL^VALM1
+3 DO EN^DDIOL(" 'Send All Bills to ClaimsManager' will send all claims listed","","!!")
+4 DO EN^DDIOL(" to ClaimsManager for processing.")
+5 DO EN^DDIOL(" 'Send All Non Auth Bills to ClaimsManager' will send only","","!!")
+6 DO EN^DDIOL(" Non-Authorized claims to ClaimsManager for processing.")
+7 DO EN^DDIOL(" 'Select Bills to send to ClaimsManager' allows individual and","","!!")
+8 DO EN^DDIOL(" multiple selection of claims before sending")
+9 DO EN^DDIOL(" claims to ClaimsManager for processing.")
+10 DO PAUSE^VALM1
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
EXIT ; -- exit code
+1 DO CLEAR^VALM1
+2 QUIT
