source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNERP8.m@ 1769

IBCNERP8 ;DAOU/BHS - IBCNE IIV STATISTICAL REPORT COMPILE ;11-JUN-2002

 ;;2.0;INTEGRATED BILLING;**184,271,345**;21-MAR-94;Build 28

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ; IIV - Insurance Identification and Verification Interface

 ;

 ;Input vars from IBCNERP7:

 ; IBCNERTN = "IBCNERP7"

 ; **IBCNESPC array ONLY passed by reference **

 ; IBCNESPC("BEGDTM") = Start Dt/Tm for rpt range

 ; IBCNESPC("ENDDTM") = End Dt/Tm for rpt range

 ; IBCNESPC("SECTS")  = 1 - All sections OR ',' sep'd list of 1 or more

 ;  of the following (not all)

 ;  2 - Outgoing data, inq trans stats

 ;  3 - Incoming data, resps rec'd stats

 ;  4 - Current status, pending resps, queued inqs, deferred inqs, payer

 ;      stats, ins buf stats

 ; IBCNESPC("MM") = "" - do not generate MailMan message OR MAILGROUP to

 ;  send report to Mail Group as defined in the IB site parameters

 ;Output vars:

 ; Based on IBCNESPC("SECTS") parameter the following scratch globals

 ; may be built

 ; 1 OR contains 2 --> 

 ; ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...

 ;  NonVerifInsExtSubtotal^NoActInsExtSubtotal

 ; 1 OR contains 3 --> 

 ; ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...

 ;  NonVerifInsExtSubtotal^NoActInsExtSubtotal

 ; 1 OR contains 4 --> 

 ; ^TMP($J,RTN,"CUR")=TotPendingResponses^TotQueuedInquiries^...

 ;  TotDeferredInquiries(Hold)^TotInsCosw/oNationalID^...

 ;  ToteIIVPyrsDisabldLocally^TotInsBufVerified^TotalManVerified...

 ;  TotalIIVVerified^TotInsBufUnverified^! InsBufSubtotal^...

 ;  ? InsBufSubtotal^- InsBufSubtotal^Other InsBufSubtotal

 ; 1 OR contains 4 -->

 ; ^TMP($J,RTN,"PYR",PAYER,IEN)=""  (list of new payers)

 ;

 ; Must call at EN

 Q

 ;

EN(IBCNERTN,IBCNESPC) ; Entry pt

 ; Init vars

 N IBBDT,IBEDT,IBSCT,IBTOT,PIECES,VALUE,CT

 ;

 I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."

 ;

 S IBTOT=0

 ;

 ; Kill scratch global

 K ^TMP($J,IBCNERTN)

 ;

 ; Init looping vars

 S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))

 S IBSCT=$G(IBCNESPC("SECTS"))

 ;

 I IBSCT=1!$F(IBSCT,",2,") D OUT(IBCNERTN,IBBDT,IBEDT,.IBTOT)

 I $G(ZTSTOP) G EXIT

 I IBSCT=1!$F(IBSCT,",3,") D IN(IBCNERTN,IBBDT,IBEDT,.IBTOT)

 I $G(ZTSTOP) G EXIT

 I IBSCT=1!$F(IBSCT,",4,") D CUR(IBCNERTN,.IBTOT),PYR^IBCNERP0(IBCNERTN,IBBDT,IBEDT,.IBTOT)

 ;

EXIT ; EN Exit pt

 Q

 ;

IN(RTN,BDT,EDT,TOT) ; Determine Incoming Data

 ; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,

 ;  EDT-end dt/time, **TOT-total records searched - used only for status

 ;  checks when the process is queued (passed by reference)

 ; Output vars: Set pcs of ^TMP($J,RTN,"IN") as follows:

 ;  1=total Resps rec'd for date/time range

 ;  2=Ins Buf extract subtotal

 ;  3=Pre-Reg extract subtotal

 ;  4=Non-ver extract subtotal

 ;  5=No Act Ins subtotal

 ;

 ; Init vars

 N IBDT,PYRIEN,PATIEN,IBPTR,IBTYP,RPTDATA,TRANSIEN

 ;

 ; Loop thru the IIV Resp File (#365) x-ref on Date/Time Resp Rec'd

 S IBDT=$O(^IBCN(365,"AD",BDT),-1)

 F  S IBDT=$O(^IBCN(365,"AD",IBDT)) Q:IBDT=""!(IBDT>EDT)  D  Q:$G(ZTSTOP)

 . S PYRIEN=0

 . F  S PYRIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN)) Q:'PYRIEN  D  Q:$G(ZTSTOP)

 . . S PATIEN=0

 . . F  S PATIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN)) Q:'PATIEN  D  Q:$G(ZTSTOP)

 . . . S IBPTR=0

 . . . F  S IBPTR=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR)) Q:'IBPTR  D  Q:$G(ZTSTOP)

 . . . . S TOT=TOT+1

 . . . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q

 . . . . ; Update total

 . . . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1

 . . . . ; Update extract type total

 . . . . ; Get the data for the report - build RPTDATA

 . . . . S IBTYP=5,TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)

 . . . . I TRANSIEN'="" S IBTYP=$P($G(^IBCN(365.1,TRANSIEN,0)),U,10)

 . . . . S $P(RPTDATA,U,IBTYP+1)=$P($G(RPTDATA),U,IBTYP+1)+1

 ;

 I $G(ZTSTOP) G INX

 ;

 ; Save data to global

 S ^TMP($J,RTN,"IN")=$G(RPTDATA)

 ;

INX ; IN exit pt

 Q

 ;

OUT(RTN,BDT,EDT,TOT) ; Outgoing Data

 ;Input params:  RTN-routine name used as subscript in ^TMP($J),

 ; BDT-start date/time, EDT-end date/time, **TOT-total recs searched-used

 ; only for status checks when process is queued (passed by reference)

 ;Output vars: Set pcs of ^TMP($J,RTN,"OUT") as follows:

 ; 1=total Inqs transmitted for timeframe

 ; 2=Ins Buffer extract subtotal

 ; 3=Pre-Reg extract subtotal

 ; 4=Non-Ver extract subtotal

 ; 5=No Act Ins subtotal

 ;

 ; Init vars

 N IBDT,IBPTR,IBTYP,RPTDATA,TQIEN

 ;

 ; Loop thru the IIV Resp File (#365) by x-ref on Date/Time Resp Created

 ;  Only count responses for unique HL7 message IDs - filter out

 ;  unsolicited responses as they artificially inflate the Outgoing Count

 S IBDT=$O(^IBCN(365,"AE",BDT),-1)

 F  S IBDT=$O(^IBCN(365,"AE",IBDT)) Q:IBDT=""!(IBDT>EDT)  D  Q:$G(ZTSTOP)

 . S IBPTR=0

 . F  S IBPTR=$O(^IBCN(365,"AE",IBDT,IBPTR)) Q:'IBPTR  D  Q:$G(ZTSTOP)

 . . S TOT=TOT+1

 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q

 . . ; Quit, if response was not O - original

 . . I $P($G(^IBCN(365,IBPTR,0)),U,10)'="O" Q

 . . ; Update total

 . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1

 . . ; Update extract type total (1,2,3,4)

 . . S IBTYP=5

 . . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)

 . . I TQIEN="" Q

 . . S IBTYP=$P($G(^IBCN(365.1,TQIEN,0)),U,10)

 . . S $P(RPTDATA,U,IBTYP+1)=$P($G(RPTDATA),U,IBTYP+1)+1

 ;

 I $G(ZTSTOP) G OUTX

 ;

 ; Save data to global array

 S ^TMP($J,RTN,"OUT")=$G(RPTDATA)

 ;

OUTX ; OUT exit pt

 Q

 ;

CUR(RTN,TOT) ; Current Status - stats - timeframe independent

 ; Input params: RTN-routine name as subs in ^TMP($J), **TOT-total recs

 ;  searched - used only for status checks when the process is queued

 ;  passed by reference

 ; Output vars: Set pcs of ^TMP($J,RTN,"CUR") as follows:

 ;  1=total Pending Resps (Transmitted-2)

 ;  2=total Queued Inqs (Ready to Transmit-1/Retry-6)

 ;  3=total Deferred Inqs (Hold-4)

 ;  4=Ins Cos w/o National ID

 ;  5=Payers w/IIV disabled locally

 ;  6=total user action required (symbol'='*' or '#' or '!' or '?' or '-')

 ;  7=total Man. Ver'd Ins Buf entries (symbol='*')

 ;  8=total IIV Processed Ver. (symbol='+')

 ;  9=total awaiting processing (symbol='?' or BLANK)

 ;  10=total Ins Buf entries w/symbol='#'

 ;  11=total Ins Buf entries w/symbol='!'

 ;  12=total Ins Buf entries w/symbol='?'

 ;  13=total Ins Buf entries w/symbol='-'

 ;  14=total Ins Buffer entries w/symbol not in ('*','#','!','?','-')

 ;

 ; Init vars

 N RIEN,TQIEN,ICIEN,IBIEN,RPTDATA,IEN,IBSYMBOL,PIECE,IBSTS,APPIEN

 N PIEN,TMP,APPDATA,XDT

 ;

 S RPTDATA=""

 ;

 ; Responses pending (Transmitted - 2)

 S RIEN=0

 F  S RIEN=$O(^IBCN(365,"AC",2,RIEN)) Q:'RIEN  D  Q:$G(ZTSTOP)

 .  S TOT=TOT+1

 .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q

 .  S $P(RPTDATA,U,1)=$P(RPTDATA,U,1)+1

 ;

 I $G(ZTSTOP) G CURX

 ;

 ; Queued inquiries (Ready to Transmit - 1/Retry - 6) and 

 ; Deferred inquiries (Hold - 4)

 F IBSTS=1,6,4 D  Q:$G(ZTSTOP)

 . S TQIEN=0

 . F  S TQIEN=$O(^IBCN(365.1,"AC",IBSTS,TQIEN)) Q:'TQIEN  D  Q:$G(ZTSTOP)

 . .  S TOT=TOT+1

 . .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT

 . .  I IBSTS'=4 S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1 Q

 . .  S $P(RPTDATA,U,3)=$P(RPTDATA,U,3)+1

 ;

 I $G(ZTSTOP) G CURX

 ;

 ; Payer stats

 ; Ins cos w/o National ID

 S ICIEN=0

 F  S ICIEN=$O(^DIC(36,ICIEN)) Q:'ICIEN  D  Q:$G(ZTSTOP)

 .  S TOT=TOT+1

 .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT

 .  ; Exclude inactive

 .  S TMP=$$ACTIVE^IBCNEUT4(ICIEN) I 'TMP Q

 .  ; Exclude Medicare/Medicaid, etc.

 .  I $$EXCLUDE^IBCNEUT4($P(TMP,U,2)) Q

 .  ; Determine assoc Payer

 .  S PIEN=$P($G(^DIC(36,ICIEN,3)),U,10)

 .  ; Missing payer link

 .  I 'PIEN S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q

 .  ; Does a VA NATIONAL ID exist?

 .  I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q

 .  S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1

 ;

 I $G(ZTSTOP) G CURX

 ;

 ; IIV Payers disabled locally

 S PIEN=0

 F  S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN  D  Q:$G(ZTSTOP)

 .  S TOT=TOT+1

 .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q

 .  ; Must have National ID

 .  I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q

 .  ; Get Payer app multiple IEN

 .  S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)

 .  ; Must have eIIV application

 .  I 'APPIEN Q

 .  S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))

 .  ; Must be Nationally Active

 .  I '$P(APPDATA,U,2) Q

 .  ; Must not be Locally Active

 .  I $P(APPDATA,U,3) Q

 .  S $P(RPTDATA,U,5)=$P(RPTDATA,U,5)+1

 ;

 I $G(ZTSTOP) G CURX

 ;

 ; Buffer stats

 ; Loop thru the Ins Buffer File (#355.33)

 S IBIEN=0,XDT=0

 F  S XDT=$O(^IBA(355.33,"AEST","E",XDT)) Q:XDT=""  D  Q:$G(ZTSTOP)

 . F  S IBIEN=$O(^IBA(355.33,"AEST","E",XDT,IBIEN)) Q:IBIEN=""  D  Q:$G(ZTSTOP)

 . . S TOT=TOT+1

 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q

 . . S IBSYMBOL=$$SYMBOL^IBCNBLL(IBIEN)

 . . ; Determine piece to update based on symbol

 . . ; ('*') = Man. Verified,  ('#','!','-','?',blank/null) = IIV Processing

 . . ; ('+') = IIV Processed

 . . S PIECE=$S(IBSYMBOL="*":7,IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,1:14)

 . . I PIECE=12!(PIECE=14) S $P(RPTDATA,U,9)=$P($G(RPTDATA),U,9)+1

 . . E  S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1

 . . S $P(RPTDATA,U,PIECE)=$P($G(RPTDATA),U,PIECE)+1

 ;

 I $G(ZTSTOP) G CURX

 ;

 ; Save data to global

 S ^TMP($J,RTN,"CUR")=$G(RPTDATA)

 ;

CURX ; CUR exit point

 Q

 ;

 ;