IBCICME1 ;DSI/ESG - IBCI CLAIMSMANAGER ERROR REPORT <CONT> ;6-APR-2001
 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
BUILD ; Build the scratch global based on the selection and sort criteria
 ;
 NEW REF,MNEMONIC,RDT,IBIFN,CMDATA,IBDATA,CMSTATUS,BILLID,PATDATA
 NEW NAME,SSN,BILLER,CODER,OIFLG,ASSIGNED,CHARGES,ERR,ERRCODES
 NEW SORT1,SORT2,SORT3,SORT4,SORT5,RPTDATA,ERRIEN,LINENO
 NEW COUNT,BILCOUNT,ERRCOUNT,INSNAME
 ;
 KILL ^TMP($J,IBCIRTN),^TMP($J,IBCIRTN_"-LIST-OF-BILLS")
 KILL ^TMP($J,IBCIRTN_"-TOTALS")
 ;
 ; which array are we looping through?  Find out here.
 S REF="RPTSPECS(""SELECTED ERRCODES"")"
 I RPTSPECS("ALL ERRCODES") S REF="^IBA(351.9,""AEC"")"
 ;
 S MNEMONIC="",(COUNT,BILCOUNT,ERRCOUNT)=0
 F  S MNEMONIC=$O(@REF@(MNEMONIC)) Q:MNEMONIC=""!$G(ZTSTOP)  D
 . S IBIFN=0
 . F  S IBIFN=$O(^IBA(351.9,"AEC",MNEMONIC,IBIFN)) Q:'IBIFN!$G(ZTSTOP)  D
 .. S COUNT=COUNT+1
 .. I $D(ZTQUEUED),COUNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
 .. S CMDATA=$G(^IBA(351.9,IBIFN,0))
 .. I CMDATA="" Q
 .. S IBDATA=$G(^DGCR(399,IBIFN,0))
 .. I IBDATA="" Q
 .. ;
 .. ; Get the date that the user selected and check it
 .. S RDT=9999999
 .. I RPTSPECS("DATYP")=1 S RDT=$P($P(IBDATA,U,3),".",1)
 .. I RPTSPECS("DATYP")=2 S RDT=$P($P($G(^DGCR(399,IBIFN,"S")),U,1),".",1)
 .. I RDT<RPTSPECS("BEGDATE") Q   ; date too early
 .. I RDT>RPTSPECS("ENDDATE") Q   ; date too late
 .. ;
 .. ; If the user chose a specific ClaimsManager status to report
 .. ; on, then make sure this bill has the status they want.
 .. S CMSTATUS=$P(CMDATA,U,2)
 .. I RPTSPECS("STATYP")=2,CMSTATUS'=RPTSPECS("IBCISTAT") Q
 .. ;
 .. ; If the user wants to see bills that are still open for editing
 .. I RPTSPECS("STATYP")=3,'$F(".1.","."_$P(IBDATA,U,13)_".") Q  ;DSI/DJW 3/21/02
 .. ;
 .. ; If the user wants to include a specific assigned to person,
 .. ; then make sure the assigned to person is the one they want.
 .. I RPTSPECS("ASNDUZ"),RPTSPECS("ASNDUZ")'=$P(CMDATA,U,12) Q
 .. ;
 .. ; At this point, we know we want to include this bill.
 .. D GETDATA
 .. I '$D(^TMP($J,IBCIRTN_"-LIST-OF-BILLS",IBIFN)) S ^TMP($J,IBCIRTN_"-LIST-OF-BILLS",IBIFN)="",BILCOUNT=BILCOUNT+1
 .. ;
 .. ; esg - 6/12/01
 .. ; Determine what the value of SORT2 should be based on the user's
 .. ; response to the Error Display Type question.
 .. ;
 .. I RPTSPECS("ERROR DISPLAY TYPE")=2 S SORT2=" "_MNEMONIC
 .. S ^TMP($J,IBCIRTN,SORT1,SORT2,SORT3,SORT4,SORT5,NAME,IBIFN)=RPTDATA
 .. ;
 .. ; continue looping to get the error level data and the totals
 .. S ERRIEN=0
 .. F  S ERRIEN=$O(^IBA(351.9,"AEC",MNEMONIC,IBIFN,ERRIEN)) Q:'ERRIEN  D
 ... S ERRCOUNT=ERRCOUNT+1
 ... S LINENO=$G(^IBA(351.9,IBIFN,1,ERRIEN,0))
 ... S LINENO=$P($P(LINENO,U,2),"~",1)
 ... S ^TMP($J,IBCIRTN,SORT1,SORT2,SORT3,SORT4,SORT5,NAME,IBIFN,ERRIEN)=LINENO_U_MNEMONIC
 ... S ^TMP($J,IBCIRTN_"-TOTALS",MNEMONIC)=$G(^TMP($J,IBCIRTN_"-TOTALS",MNEMONIC))+1
 ... Q
 .. Q
 . Q
 S ^TMP($J,IBCIRTN_"-TOTALS")=BILCOUNT_U_ERRCOUNT
 KILL ^TMP($J,IBCIRTN_"-LIST-OF-BILLS")
 ;
BUILDX ;
 Q
 ;
 ;
GETDATA ; Retrieve the data for this bill
 S BILLID=$P(IBDATA,U,1)                              ; bill number
 S PATDATA=$G(^DPT(+$P(IBDATA,U,2),0))
 I PATDATA="" Q
 S NAME=$P(PATDATA,U,1)                               ; patient name
 I NAME="" S NAME="UNKNOWN"
 S NAMESUB=$E(NAME,1,15)_+$P(IBDATA,U,2)              ; name subscript
 S SSN=$P(PATDATA,U,9)                                ; patient ssn
 S BILLER=$P($$BILLER^IBCIUT5(IBIFN),U,2)
 I BILLER="" S BILLER="UNKNOWN"
 S CODER=$$CODER^IBCIUT5(IBIFN)
 S OIFLG=$P(CODER,U,1)               ; inpatient/outpatient flag
 S CODER=$P(CODER,U,3)
 I CODER="" S CODER="UNKNOWN"
 S ASSIGNED=$P($G(^VA(200,+$P(CMDATA,U,12),0)),U,1)   ; assigned to
 I ASSIGNED="" S ASSIGNED="UNASSIGNED"
 S ASNSUB=$E(ASSIGNED,1,12)_+$P(CMDATA,U,12)     ; assigned to subscript
 S CHARGES=+$P($G(^DGCR(399,IBIFN,"U1")),U,1)         ; total charges
 S (ERR,ERRCODES)=""
 F  S ERR=$O(^IBA(351.9,IBIFN,1,"B",ERR)) Q:ERR=""  D
 . I ERRCODES="" S ERRCODES=ERR
 . E  S ERRCODES=ERRCODES_","_ERR    ; build the list of error codes
 . Q
 ;
 ; set the sort variables and build the scratch global
 S (SORT1,SORT2,SORT3,SORT4,SORT5)=1
 I RPTSPECS("ASNSORT") S SORT3=" "_ASNSUB
 I RPTSPECS("SORTBY")=1 S SORT4=" "_$P($$TD^IBCIUT5(IBIFN),U,1)
 I RPTSPECS("SORTBY")=2 D
 . S INSNAME=$P($G(^DIC(36,+$$FINDINS^IBCEF1(IBIFN),0)),U,1)
 . I INSNAME="" S INSNAME="~~~ NO INSURANCE ~~~"
 . S SORT4=" "_$E(INSNAME,1,25)
 . Q
 I RPTSPECS("SORTBY")=3 S SORT4=" "_NAMESUB
 I RPTSPECS("SORTBY")=4 S SORT4=-CHARGES
 I RPTSPECS("SORTBY")=5 S SORT4=" "_BILLID
 ;
 S RPTDATA=BILLID_U_SSN_U_$P(RDT,".",1)_U_BILLER_U_CODER_U_ASSIGNED_U_OIFLG_U_CHARGES_U_CMSTATUS_U_ERRCODES
 ;
 ; Build an array with the total number of bills in each status
 ; This array will be used in the report print routines and it is
 ; available in both the status report and the error report.
 ; esg - 5/22/01
 ;
 ; bill count by status
 S IBCISCNT(1,CMSTATUS)=$G(IBCISCNT(1,CMSTATUS))+1
 S IBCISCNT(1)=$G(IBCISCNT(1))+1
 ;
 ; charges by status
 S IBCISCNT(2,CMSTATUS)=$G(IBCISCNT(2,CMSTATUS))+CHARGES
 S IBCISCNT(2)=$G(IBCISCNT(2))+CHARGES
 ;
GETDATX ;
 Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCICME1   5330     printed  Sep 23, 2025@19:49:26                                                                                                                                                                                                    Page 2
IBCICME1  ;DSI/ESG - IBCI CLAIMSMANAGER ERROR REPORT <CONT> ;6-APR-2001
 +1       ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.
 +3       ;
BUILD     ; Build the scratch global based on the selection and sort criteria
 +1       ;
 +2        NEW REF,MNEMONIC,RDT,IBIFN,CMDATA,IBDATA,CMSTATUS,BILLID,PATDATA
 +3        NEW NAME,SSN,BILLER,CODER,OIFLG,ASSIGNED,CHARGES,ERR,ERRCODES
 +4        NEW SORT1,SORT2,SORT3,SORT4,SORT5,RPTDATA,ERRIEN,LINENO
 +5        NEW COUNT,BILCOUNT,ERRCOUNT,INSNAME
 +6       ;
 +7        KILL ^TMP($JOB,IBCIRTN),^TMP($JOB,IBCIRTN_"-LIST-OF-BILLS")
 +8        KILL ^TMP($JOB,IBCIRTN_"-TOTALS")
 +9       ;
 +10      ; which array are we looping through?  Find out here.
 +11       SET REF="RPTSPECS(""SELECTED ERRCODES"")"
 +12       IF RPTSPECS("ALL ERRCODES")
               SET REF="^IBA(351.9,""AEC"")"
 +13      ;
 +14       SET MNEMONIC=""
           SET (COUNT,BILCOUNT,ERRCOUNT)=0
 +15       FOR 
               SET MNEMONIC=$ORDER(@REF@(MNEMONIC))
               if MNEMONIC=""!$GET(ZTSTOP)
                   QUIT 
               Begin DoDot:1
 +16               SET IBIFN=0
 +17               FOR 
                       SET IBIFN=$ORDER(^IBA(351.9,"AEC",MNEMONIC,IBIFN))
                       if 'IBIFN!$GET(ZTSTOP)
                           QUIT 
                       Begin DoDot:2
 +18                       SET COUNT=COUNT+1
 +19                       IF $DATA(ZTQUEUED)
                               IF COUNT#100=0
                                   IF $$S^%ZTLOAD()
                                       SET ZTSTOP=1
                                       QUIT 
 +20                       SET CMDATA=$GET(^IBA(351.9,IBIFN,0))
 +21                       IF CMDATA=""
                               QUIT 
 +22                       SET IBDATA=$GET(^DGCR(399,IBIFN,0))
 +23                       IF IBDATA=""
                               QUIT 
 +24      ;
 +25      ; Get the date that the user selected and check it
 +26                       SET RDT=9999999
 +27                       IF RPTSPECS("DATYP")=1
                               SET RDT=$PIECE($PIECE(IBDATA,U,3),".",1)
 +28                       IF RPTSPECS("DATYP")=2
                               SET RDT=$PIECE($PIECE($GET(^DGCR(399,IBIFN,"S")),U,1),".",1)
 +29      ; date too early
                           IF RDT<RPTSPECS("BEGDATE")
                               QUIT 
 +30      ; date too late
                           IF RDT>RPTSPECS("ENDDATE")
                               QUIT 
 +31      ;
 +32      ; If the user chose a specific ClaimsManager status to report
 +33      ; on, then make sure this bill has the status they want.
 +34                       SET CMSTATUS=$PIECE(CMDATA,U,2)
 +35                       IF RPTSPECS("STATYP")=2
                               IF CMSTATUS'=RPTSPECS("IBCISTAT")
                                   QUIT 
 +36      ;
 +37      ; If the user wants to see bills that are still open for editing
 +38      ;DSI/DJW 3/21/02
                           IF RPTSPECS("STATYP")=3
                               IF '$FIND(".1.","."_$PIECE(IBDATA,U,13)_".")
                                   QUIT 
 +39      ;
 +40      ; If the user wants to include a specific assigned to person,
 +41      ; then make sure the assigned to person is the one they want.
 +42                       IF RPTSPECS("ASNDUZ")
                               IF RPTSPECS("ASNDUZ")'=$PIECE(CMDATA,U,12)
                                   QUIT 
 +43      ;
 +44      ; At this point, we know we want to include this bill.
 +45                       DO GETDATA
 +46                       IF '$DATA(^TMP($JOB,IBCIRTN_"-LIST-OF-BILLS",IBIFN))
                               SET ^TMP($JOB,IBCIRTN_"-LIST-OF-BILLS",IBIFN)=""
                               SET BILCOUNT=BILCOUNT+1
 +47      ;
 +48      ; esg - 6/12/01
 +49      ; Determine what the value of SORT2 should be based on the user's
 +50      ; response to the Error Display Type question.
 +51      ;
 +52                       IF RPTSPECS("ERROR DISPLAY TYPE")=2
                               SET SORT2=" "_MNEMONIC
 +53                       SET ^TMP($JOB,IBCIRTN,SORT1,SORT2,SORT3,SORT4,SORT5,NAME,IBIFN)=RPTDATA
 +54      ;
 +55      ; continue looping to get the error level data and the totals
 +56                       SET ERRIEN=0
 +57                       FOR 
                               SET ERRIEN=$ORDER(^IBA(351.9,"AEC",MNEMONIC,IBIFN,ERRIEN))
                               if 'ERRIEN
                                   QUIT 
                               Begin DoDot:3
 +58                               SET ERRCOUNT=ERRCOUNT+1
 +59                               SET LINENO=$GET(^IBA(351.9,IBIFN,1,ERRIEN,0))
 +60                               SET LINENO=$PIECE($PIECE(LINENO,U,2),"~",1)
 +61                               SET ^TMP($JOB,IBCIRTN,SORT1,SORT2,SORT3,SORT4,SORT5,NAME,IBIFN,ERRIEN)=LINENO_U_MNEMONIC
 +62                               SET ^TMP($JOB,IBCIRTN_"-TOTALS",MNEMONIC)=$GET(^TMP($JOB,IBCIRTN_"-TOTALS",MNEMONIC))+1
 +63                               QUIT 
                               End DoDot:3
 +64                       QUIT 
                       End DoDot:2
 +65               QUIT 
               End DoDot:1
 +66       SET ^TMP($JOB,IBCIRTN_"-TOTALS")=BILCOUNT_U_ERRCOUNT
 +67       KILL ^TMP($JOB,IBCIRTN_"-LIST-OF-BILLS")
 +68      ;
BUILDX    ;
 +1        QUIT 
 +2       ;
 +3       ;
GETDATA   ; Retrieve the data for this bill
 +1       ; bill number
           SET BILLID=$PIECE(IBDATA,U,1)
 +2        SET PATDATA=$GET(^DPT(+$PIECE(IBDATA,U,2),0))
 +3        IF PATDATA=""
               QUIT 
 +4       ; patient name
           SET NAME=$PIECE(PATDATA,U,1)
 +5        IF NAME=""
               SET NAME="UNKNOWN"
 +6       ; name subscript
           SET NAMESUB=$EXTRACT(NAME,1,15)_+$PIECE(IBDATA,U,2)
 +7       ; patient ssn
           SET SSN=$PIECE(PATDATA,U,9)
 +8        SET BILLER=$PIECE($$BILLER^IBCIUT5(IBIFN),U,2)
 +9        IF BILLER=""
               SET BILLER="UNKNOWN"
 +10       SET CODER=$$CODER^IBCIUT5(IBIFN)
 +11      ; inpatient/outpatient flag
           SET OIFLG=$PIECE(CODER,U,1)
 +12       SET CODER=$PIECE(CODER,U,3)
 +13       IF CODER=""
               SET CODER="UNKNOWN"
 +14      ; assigned to
           SET ASSIGNED=$PIECE($GET(^VA(200,+$PIECE(CMDATA,U,12),0)),U,1)
 +15       IF ASSIGNED=""
               SET ASSIGNED="UNASSIGNED"
 +16      ; assigned to subscript
           SET ASNSUB=$EXTRACT(ASSIGNED,1,12)_+$PIECE(CMDATA,U,12)
 +17      ; total charges
           SET CHARGES=+$PIECE($GET(^DGCR(399,IBIFN,"U1")),U,1)
 +18       SET (ERR,ERRCODES)=""
 +19       FOR 
               SET ERR=$ORDER(^IBA(351.9,IBIFN,1,"B",ERR))
               if ERR=""
                   QUIT 
               Begin DoDot:1
 +20               IF ERRCODES=""
                       SET ERRCODES=ERR
 +21      ; build the list of error codes
                  IF '$TEST
                       SET ERRCODES=ERRCODES_","_ERR
 +22               QUIT 
               End DoDot:1
 +23      ;
 +24      ; set the sort variables and build the scratch global
 +25       SET (SORT1,SORT2,SORT3,SORT4,SORT5)=1
 +26       IF RPTSPECS("ASNSORT")
               SET SORT3=" "_ASNSUB
 +27       IF RPTSPECS("SORTBY")=1
               SET SORT4=" "_$PIECE($$TD^IBCIUT5(IBIFN),U,1)
 +28       IF RPTSPECS("SORTBY")=2
               Begin DoDot:1
 +29               SET INSNAME=$PIECE($GET(^DIC(36,+$$FINDINS^IBCEF1(IBIFN),0)),U,1)
 +30               IF INSNAME=""
                       SET INSNAME="~~~ NO INSURANCE ~~~"
 +31               SET SORT4=" "_$EXTRACT(INSNAME,1,25)
 +32               QUIT 
               End DoDot:1
 +33       IF RPTSPECS("SORTBY")=3
               SET SORT4=" "_NAMESUB
 +34       IF RPTSPECS("SORTBY")=4
               SET SORT4=-CHARGES
 +35       IF RPTSPECS("SORTBY")=5
               SET SORT4=" "_BILLID
 +36      ;
 +37       SET RPTDATA=BILLID_U_SSN_U_$PIECE(RDT,".",1)_U_BILLER_U_CODER_U_ASSIGNED_U_OIFLG_U_CHARGES_U_CMSTATUS_U_ERRCODES
 +38      ;
 +39      ; Build an array with the total number of bills in each status
 +40      ; This array will be used in the report print routines and it is
 +41      ; available in both the status report and the error report.
 +42      ; esg - 5/22/01
 +43      ;
 +44      ; bill count by status
 +45       SET IBCISCNT(1,CMSTATUS)=$GET(IBCISCNT(1,CMSTATUS))+1
 +46       SET IBCISCNT(1)=$GET(IBCISCNT(1))+1
 +47      ;
 +48      ; charges by status
 +49       SET IBCISCNT(2,CMSTATUS)=$GET(IBCISCNT(2,CMSTATUS))+CHARGES
 +50       SET IBCISCNT(2)=$GET(IBCISCNT(2))+CHARGES
 +51      ;
GETDATX   ;
 +1        QUIT 
 +2       ;