Routine: IBCIL0

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

HDR ; -- header code

 S VALMHDR(1)="                      Welcome to ClaimsManager Bill Processing"

 S VALMHDR(2)="          This ListMan will display all skipped bills for processing"

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

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 ;

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

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)

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

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

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 ;

NOBILS ;msg for no bills

 D FULL^VALM1

 W !!,"There are no claims to send ...",!

 S DIR(0)="E" D ^DIR K DIR

YESBLS ;msg for sending bills

 W !!,"Sending claims ... please wait.",!

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"

EXIT ; -- exit code

 D CLEAR^VALM1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIL0   9640     printed  Feb 18, 2025@23:39:41                                                                                                                                                                                                      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

IBCIL0.m