IBCNERP8 ;DAOU/BHS - IBCNE eIV STATISTICAL REPORT COMPILE ;11-JUN-2002
;;2.0;INTEGRATED BILLING;**184,271,345,416,506,621,631,668,687,737,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance 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, payer stats, ins buf stats ;IB*752/DTG removed Deferred
;
; 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
;IB*752/DTG remove deferred inquiries, while maintaining piece integrity
; 1 OR contains 4 -->
; ^TMP($J,RTN,"CUR")=TotPendingResponses^TotQueuedInquiries^...
; NULL (was Deferred)^TotInsCosw/oNationalID^...
; ToteIVPyrsDisabldLocally^TotUserActReq^TotInsBufVerified^TotalManVerified...
; TotaleIVVerified^TotInsBufUnverified^! InsBufSubtotal^...
; ? InsBufSubtotal^- InsBufSubtotal^Other InsBufSubtotal^...
; $ EscolatedBufSubtotal
; 1 OR contains 4 -->
; ^TMP($J,RTN,"PYR",APP,PAYER,IEN)="" (list of new payers) ;IB*2.0*687
;
; Must call at EN
;
; /ckb-IB*2*687 Added APP to incorporate IIU into this rpt; corrected
; references from Nationally active & locally active to
; Nationally and Locally enabled
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,IBBDT,IBEDT,.IBTOT),PYR(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 eIV 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
. . . . ;IB*2.0*631/TAZ
. . . . ;S IBTYP=5,TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
. . . . S TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
. . . . ; IB*2.0*621
. . . . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
. . . . I TQIEN="" Q
. . . . S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
. . . . S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
. . . . S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
. . . . I IBTYP'="" D
. . . . . I IBTYP=3 Q
. . . . . ;IB*2.0*631
. . . . . I IBTYP=7 S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1 Q ; MBI Request``
. . . . . I ("~1~5~6~"[("~"_IBTYP_"~")) S $P(RPTDATA,U,2)=$P($G(RPTDATA),U,2)+1 Q
. . . . . I IBTYP=4 D Q
. . . . . . I IBQUERY="I" S $P(RPTDATA,U,4)=$P($G(RPTDATA),U,4)+1 ; EICD Queries
. . . . . . I IBQUERY="V" S $P(RPTDATA,U,5)=$P($G(RPTDATA),U,5)+1 ; EICD Verification
. . . . . S:IBTYP=2 $P(RPTDATA,U,3)=$P($G(RPTDATA),U,3)+1
. . . . ; IB*2.0*621 - End IN Group
;
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
; 6=MBI subtotal
;
; Init vars
N IBDT,IBPTR,IBTYP,RPTDATA,TQIEN
;
; Loop thru the eIV 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 TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
. . I TQIEN="" Q
. . ; IB*2.0*621
. . ;S IBTYP=$P($G(^IBCN(365.1,TQIEN,0)),U,10)
. . S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
. . S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
. . S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
. . I IBTYP'="" D
. . . I IBTYP=3 Q
. . . ;I IBTYP=1 D Q ;IB*2.0*631/TAZ
. . . I IBTYP=7 S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1 Q ; MBI Request``
. . . I ("~1~5~6~"[("~"_IBTYP_"~")) S $P(RPTDATA,U,2)=$P($G(RPTDATA),U,2)+1 Q
. . . I IBTYP=4 D Q
. . . . I IBQUERY="I" S $P(RPTDATA,U,4)=$P($G(RPTDATA),U,4)+1 ; EICD Queries
. . . . I IBQUERY="V" S $P(RPTDATA,U,5)=$P($G(RPTDATA),U,5)+1 ; EICD Verification
. . . S:IBTYP=2 $P(RPTDATA,U,3)=$P($G(RPTDATA),U,3)+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,BDT,EDT,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/eIV locally enabled is NO ;/vd-IB*2*687 - Reworded the description.
; ; 6=total user action required (symbol'='*' or '#' or '!' or '?' or '-')
; 6=total user action required (symbol'='#' or '!' or '?' or '-') ;IB*737/DTG stop use of '*' verified
; 7=total Man. Ver'd Ins Buf entries (symbol='*') ;IB*737/DTG stop use of '*' verified
; 8=total eIV 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 ('*','#','!','?','-')
; 14=total Ins Buffer entries w/symbol not in ('#','!','?','-') ;IB*737/DTG stop use of '*' verified
; 15=total Ins Buffer entries w/symbol='$'
; 16=total Ins Buffet entries w/symbol= % ; IB*2.0*621 - Added 16-21
; 17=total Insurance Buffer
; 18=Total Appointment
; 19=total Ele Ins Cov Discovery (EICD)
; 20=total EICD Triggered Einsurance Verification
; 21=total MBI Inquiry
; 22=total IIU Payer 'Received IIU Data' set to NO ;IB*2.0*687
;
; ^TMP($J,RTN,"CUR","FLAGS","NE",APP,Payer name,N) = nationally enabled flag timestamp ^ nationally enabled flag setting
; ^TMP($J,RTN,"CUR","FLAGS","AU",APP,Payer name,N) = auto updated flag timestamp ^ auto update flag setting
;
;/ckb-IB*2.0*687 Added APP to incorporate IIU into this report;
; added IIU Payer 'Received IIU Data' set to NO to the report;
; corrected references from Active (A) & Trusted (T) to
; Nationally Enabled (NE) and Auto Update (AU)
;
; Init vars
N RIEN,TQIEN,ICIEN,IBIEN,RPTDATA,IEN,IBSYMBOL,PIECE,IBSTS,APPIEN
N PIEN,TMP,APPDATA,XDT,PDATA
;
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
. ; IB*2.0*621
. S TQIEN=$P($G(^IBCN(365,RIEN,0)),U,5)
. I TQIEN="" Q
. S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
. S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
. S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
. I IBTYP'="" D
. . I IBTYP=3 Q
. . ;I IBTYP=1 D Q ;IB*2.0*631
. . I IBTYP=7 S $P(RPTDATA,U,21)=$P($G(RPTDATA),U,21)+1 Q ; MBI Request``
. . I ("~1~5~6~"[("~"_IBTYP_"~")) S $P(RPTDATA,U,17)=$P($G(RPTDATA),U,17)+1 Q
. S:IBTYP=2 $P(RPTDATA,U,18)=$P($G(RPTDATA),U,18)+1 ; Appointment
. I IBTYP=4 D Q
. . I IBQUERY="I" S $P(RPTDATA,U,19)=$P($G(RPTDATA),U,19)+1 ; EICD Queries
. . I IBQUERY="V" S $P(RPTDATA,U,20)=$P($G(RPTDATA),U,20)+1 ; EICD Verification
. ; IB*2.0*621 - End IN Group
;
I $G(ZTSTOP) G CURX
;
; Queued inquiries (Ready to Transmit - 1/Retry - 6) and
; IB*752/DTG REMOVED ; Deferred inquiries (Hold - 4)
;F IBSTS=1,6,4 D Q:$G(ZTSTOP)
F IBSTS=1,6 D Q:$G(ZTSTOP) ; IB*752/DTG remove (4) Deferred
. 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
. . ; IB*752/DTG remove Deferred
. . ;I IBSTS'=4 S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1 Q
. . ;S $P(RPTDATA,U,3)=$P(RPTDATA,U,3)+1
. . S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1
;
I $G(ZTSTOP) G CURX
;
; Payer stats
; Ins cos w/o National ID
S ICIEN=0,$P(RPTDATA,U,4)=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 Medicaid, etc.
. I $$EXCLUDE^IBCNEUT4($P(TMP,U,2)) Q
. ; Does a NATIONAL ID exist?
. ; VA CBO defines 'No National ID' as lack of EDI IDs - fields (#36,3.02) & (#36,3.04) 3/4/14
. ; This is *NOT* a check for the 'VA NATIONAL ID' associated with the linked payer
. I ($$GET1^DIQ(36,ICIEN_",",3.02)="")&($$GET1^DIQ(36,ICIEN_",",3.04)="") S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
. 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
;
; eIV Payers locally enabled is NO ;/ckb-IB*2.0*687 - Reworded the comment
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
. S PDATA=$G(^IBE(365.12,PIEN,0))
. ; Must have National ID
. I $P(PDATA,U,2)="" Q
. ; Get Payer app multiple IEN
. ; /ckb-IB*2.0*687 - Replaced the following code.
. ;IB*668/TAZ - Changed Payer Application from IIV to EIV
. ;S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
. ; Must have eIV application
. ;I 'APPIEN Q
. ; Get Active/Trusted flag logs
. ;D GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,.RPTDATA)
. ;
. ;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
. ;
. N IENEIV,IENIIU
. K APPDATA
. S IENEIV=$$PYRAPP^IBCNEUT5("EIV",PIEN)
. S IENIIU=$$PYRAPP^IBCNEUT5("IIU",PIEN)
. I 'IENEIV,'IENIIU Q ; Payer doesn't have any applications.
. ;'Receive IIU Data' field is set to NO (0), null values are also considered NO.
. I IENIIU D
. . ; Get the Nationally Enabled/Auto Update flag logs
. . D GETFLAGS(PIEN,IENIIU,PDATA,BDT,EDT,"IIU",.RPTDATA)
. . S APPDATA=$G(^IBE(365.12,PIEN,1,IENIIU,0))
. . ; Must be Nationally Enabled
. . I '$P(APPDATA,U,2) Q
. . I $P($G(^IBE(365.12,PIEN,1,IENIIU,5)),U)'=1 S $P(RPTDATA,U,22)=$P(RPTDATA,U,22)+1
. I IENEIV D
. . ; Get the Nationally Enabled/Auto Update flag logs
. . D GETFLAGS(PIEN,IENEIV,PDATA,BDT,EDT,"EIV",.RPTDATA)
. . S APPDATA=$G(^IBE(365.12,PIEN,1,IENEIV,0))
. . ; Must be Nationally Enabled
. . I '$P(APPDATA,U,2) Q
. . ; Must not be Locally Enabled
. . I $P(APPDATA,U,3) Q
. . S $P(RPTDATA,U,5)=$P(RPTDATA,U,5)+1
;/ckb-IB*2.0*687 End of new code
;
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) = eIV Processing
. . ; ('#','!','-','?',blank/null) = eIV Processing ;IB*737/DTG stop use of '*' verified
. . ; ('+') = eIV Processed, ('$') = Escalated, Active policy
. . ; IB*2.0*506/taz Node 15 added.
. . ; IB*2.0*621/ Node 16 Added.
. . ;S PIECE=$S(IBSYMBOL="*":7,IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,IBSYMBOL="$":15,IBSYMBOL="%":16,1:14)
. . S PIECE=$S(IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,IBSYMBOL="$":15,IBSYMBOL="%":16,1:14) ;IB*737/DTG stop use of '*' verified
. . 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
CURM ;
; Save data to global
M ^TMP($J,RTN,"CUR")=RPTDATA
;
CURX ; CUR exit point
Q
;
;/ckb-IB*2.0*687 - GETFLAGS is rewritten to incorporate IIU and improve readability.
; This function is only called by CUR^IBCNERP8; it is called by IBCNERPC but not used.
GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,APP,RPTDATA) ;
; PIEN - Payer ien in file 365.12
; APPIEN - Application ien in subfile 365.121
; PDATA - 0 node of Payer file entry
; BDT - Start date/time
; EDT - End date/time
; APP - Payer Application EIV or IIU
; RPTDATA - output array, passed by reference
;
N FLAGS,IEN,PNAME,TYP,TM,VAL,Z
S PNAME=$P(PDATA,U)
I '$D(APP) S APP=0 ;to prevent error when called from IBCNERPC
; TYP=2 Nationally Enabled Log / TYP=3 Auto-Update Log
F TYP=2,3 D
. S TM=EDT,Z=0 F S TM=$O(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM),-1) Q:TM=""!($$FMDIFF^XLFDT(TM,BDT,2)'>0) D
. . S IEN=$O(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM,""))
. . S VAL=$$EXTERNAL^DILFD("365.121"_TYP,.02,,$P(^IBE(365.12,PIEN,1,APPIEN,TYP,IEN,0),U,2))
. . S Z=Z+1
. . S RPTDATA("FLAGS",APP,$S(TYP=2:"NE",1:"AU"),PNAME,Z)=$$FMTE^XLFDT(TM,"5ZS")_"^"_VAL
. . Q
Q
;
PYR(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 ^TMP($J,RTN,"PYR",APP,PAYER NAME,IEN of file 365.12)="" ;IB*2.0*687
;
; /ckb-IB*2*687 Added APP to incorporate IIU into this report. Moved from IBCNERP0.
;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
;
;N PIEN,PYR,CREATEDT,APPIEN,APPDATA
N PIEN,PYR,CREATEDT,APP,APPIEN,APPDATA
S PIEN=0 F S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN D
. S PYR=$P($G(^IBE(365.12,PIEN,0)),U)
. S TOT=TOT+1
. F APP="EIV","IIU" D
. . S APPIEN=+$$PYRAPP^IBCNEUT5(APP,+PIEN) ; Get the ien of the application
. . I 'APPIEN Q ; No application for this Payer.
. . ; Get the Date/Time Created from the Application
. . S CREATEDT=$P($G(^IBE(365.12,PIEN,1,APPIEN,0)),U,13)
. . I CREATEDT=""!(CREATEDT<BDT)!(CREATEDT>EDT) Q
. . ;
. . ; Get Payer app multiple IEN
. . ;IB*668/TAZ - Changed Payer Application from IIV to EIV
. . ;S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
. . ; Must have eIV application
. . ;I 'APPIEN Q
. . ;IB*687 -remove Nationally Active check
. . ;S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
. . ; Must be Nationally Active
. . ;I '$P(APPDATA,U,2) Q
. . ;
. . S ^TMP($J,RTN,"PYR",APP,PYR,PIEN)=""
. . Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERP8 17814 printed Apr 09, 2024@21:20:15 Page 2
IBCNERP8 ;DAOU/BHS - IBCNE eIV STATISTICAL REPORT COMPILE ;11-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,345,416,506,621,631,668,687,737,752**;21-MAR-94;Build 20
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; eIV - Insurance Verification Interface
+5 ;
+6 ;Input vars from IBCNERP7:
+7 ; IBCNERTN = "IBCNERP7"
+8 ; **IBCNESPC array ONLY passed by reference **
+9 ; IBCNESPC("BEGDTM") = Start Dt/Tm for rpt range
+10 ; IBCNESPC("ENDDTM") = End Dt/Tm for rpt range
+11 ; IBCNESPC("SECTS") = 1 - All sections OR ',' sep'd list of 1 or more
+12 ; of the following (not all)
+13 ; 2 - Outgoing data, inq trans stats
+14 ; 3 - Incoming data, resps rec'd stats
+15 ; 4 - Current status, pending resps, queued inqs, payer stats, ins buf stats ;IB*752/DTG removed Deferred
+16 ;
+17 ; IBCNESPC("MM") = "" - do not generate MailMan message OR MAILGROUP to
+18 ; send report to Mail Group as defined in the IB site parameters
+19 ;Output vars:
+20 ; Based on IBCNESPC("SECTS") parameter the following scratch globals
+21 ; may be built
+22 ; 1 OR contains 2 -->
+23 ; ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
+24 ; NonVerifInsExtSubtotal^NoActInsExtSubtotal
+25 ; 1 OR contains 3 -->
+26 ; ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
+27 ; NonVerifInsExtSubtotal^NoActInsExtSubtotal
+28 ;IB*752/DTG remove deferred inquiries, while maintaining piece integrity
+29 ; 1 OR contains 4 -->
+30 ; ^TMP($J,RTN,"CUR")=TotPendingResponses^TotQueuedInquiries^...
+31 ; NULL (was Deferred)^TotInsCosw/oNationalID^...
+32 ; ToteIVPyrsDisabldLocally^TotUserActReq^TotInsBufVerified^TotalManVerified...
+33 ; TotaleIVVerified^TotInsBufUnverified^! InsBufSubtotal^...
+34 ; ? InsBufSubtotal^- InsBufSubtotal^Other InsBufSubtotal^...
+35 ; $ EscolatedBufSubtotal
+36 ; 1 OR contains 4 -->
+37 ; ^TMP($J,RTN,"PYR",APP,PAYER,IEN)="" (list of new payers) ;IB*2.0*687
+38 ;
+39 ; Must call at EN
+40 ;
+41 ; /ckb-IB*2*687 Added APP to incorporate IIU into this rpt; corrected
+42 ; references from Nationally active & locally active to
+43 ; Nationally and Locally enabled
+44 QUIT
+45 ;
EN(IBCNERTN,IBCNESPC) ; Entry pt
+1 ; Init vars
+2 NEW IBBDT,IBEDT,IBSCT,IBTOT,PIECES,VALUE,CT
+3 ;
+4 IF '$DATA(ZTQUEUED)
IF $GET(IOST)["C-"
WRITE !!,"Compiling report data ..."
+5 ;
+6 SET IBTOT=0
+7 ;
+8 ; Kill scratch global
+9 KILL ^TMP($JOB,IBCNERTN)
+10 ;
+11 ; Init looping vars
+12 SET IBBDT=$GET(IBCNESPC("BEGDTM"))
SET IBEDT=$GET(IBCNESPC("ENDDTM"))
+13 SET IBSCT=$GET(IBCNESPC("SECTS"))
+14 ;
+15 IF IBSCT=1!$FIND(IBSCT,",2,")
DO OUT(IBCNERTN,IBBDT,IBEDT,.IBTOT)
+16 IF $GET(ZTSTOP)
GOTO EXIT
+17 IF IBSCT=1!$FIND(IBSCT,",3,")
DO IN(IBCNERTN,IBBDT,IBEDT,.IBTOT)
+18 IF $GET(ZTSTOP)
GOTO EXIT
+19 IF IBSCT=1!$FIND(IBSCT,",4,")
DO CUR(IBCNERTN,IBBDT,IBEDT,.IBTOT)
DO PYR(IBCNERTN,IBBDT,IBEDT,.IBTOT)
+20 ;
EXIT ; EN Exit pt
+1 QUIT
+2 ;
IN(RTN,BDT,EDT,TOT) ; Determine Incoming Data
+1 ; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,
+2 ; EDT-end dt/time, **TOT-total records searched - used only for status
+3 ; checks when the process is queued (passed by reference)
+4 ; Output vars: Set pcs of ^TMP($J,RTN,"IN") as follows:
+5 ; 1=total Resps rec'd for date/time range
+6 ; 2=Ins Buf extract subtotal
+7 ; 3=Pre-Reg extract subtotal
+8 ; 4=Non-ver extract subtotal
+9 ; 5=No Act Ins subtotal
+10 ;
+11 ; Init vars
+12 NEW IBDT,PYRIEN,PATIEN,IBPTR,IBTYP,RPTDATA,TRANSIEN
+13 ;
+14 ; Loop thru the eIV Resp File (#365) x-ref on Date/Time Resp Rec'd
+15 SET IBDT=$ORDER(^IBCN(365,"AD",BDT),-1)
+16 FOR
SET IBDT=$ORDER(^IBCN(365,"AD",IBDT))
if IBDT=""!(IBDT>EDT)
QUIT
Begin DoDot:1
+17 SET PYRIEN=0
+18 FOR
SET PYRIEN=$ORDER(^IBCN(365,"AD",IBDT,PYRIEN))
if 'PYRIEN
QUIT
Begin DoDot:2
+19 SET PATIEN=0
+20 FOR
SET PATIEN=$ORDER(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN))
if 'PATIEN
QUIT
Begin DoDot:3
+21 SET IBPTR=0
+22 FOR
SET IBPTR=$ORDER(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR))
if 'IBPTR
QUIT
Begin DoDot:4
+23 SET TOT=TOT+1
+24 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+25 ; Update total
+26 SET $PIECE(RPTDATA,U,1)=$PIECE($GET(RPTDATA),U,1)+1
+27 ; Update extract type total
+28 ; Get the data for the report - build RPTDATA
+29 ;IB*2.0*631/TAZ
+30 ;S IBTYP=5,TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
+31 SET TRANSIEN=$PIECE($GET(^IBCN(365,IBPTR,0)),U,5)
+32 ; IB*2.0*621
+33 SET TQIEN=$PIECE($GET(^IBCN(365,IBPTR,0)),U,5)
+34 IF TQIEN=""
QUIT
+35 SET IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
+36 SET IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
+37 SET IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
+38 IF IBTYP'=""
Begin DoDot:5
+39 IF IBTYP=3
QUIT
+40 ;IB*2.0*631
+41 ; MBI Request``
IF IBTYP=7
SET $PIECE(RPTDATA,U,6)=$PIECE($GET(RPTDATA),U,6)+1
QUIT
+42 IF ("~1~5~6~"[("~"_IBTYP_"~"))
SET $PIECE(RPTDATA,U,2)=$PIECE($GET(RPTDATA),U,2)+1
QUIT
+43 IF IBTYP=4
Begin DoDot:6
+44 ; EICD Queries
IF IBQUERY="I"
SET $PIECE(RPTDATA,U,4)=$PIECE($GET(RPTDATA),U,4)+1
+45 ; EICD Verification
IF IBQUERY="V"
SET $PIECE(RPTDATA,U,5)=$PIECE($GET(RPTDATA),U,5)+1
End DoDot:6
QUIT
+46 if IBTYP=2
SET $PIECE(RPTDATA,U,3)=$PIECE($GET(RPTDATA),U,3)+1
End DoDot:5
+47 ; IB*2.0*621 - End IN Group
End DoDot:4
if $GET(ZTSTOP)
QUIT
End DoDot:3
if $GET(ZTSTOP)
QUIT
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+48 ;
+49 IF $GET(ZTSTOP)
GOTO INX
+50 ;
+51 ; Save data to global
+52 SET ^TMP($JOB,RTN,"IN")=$GET(RPTDATA)
+53 ;
INX ; IN exit pt
+1 QUIT
+2 ;
OUT(RTN,BDT,EDT,TOT) ; Outgoing Data
+1 ;Input params: RTN-routine name used as subscript in ^TMP($J),
+2 ; BDT-start date/time, EDT-end date/time, **TOT-total recs searched-used
+3 ; only for status checks when process is queued (passed by reference)
+4 ;Output vars: Set pcs of ^TMP($J,RTN,"OUT") as follows:
+5 ; 1=total Inqs transmitted for timeframe
+6 ; 2=Ins Buffer extract subtotal
+7 ; 3=Pre-Reg extract subtotal
+8 ; 4=Non-Ver extract subtotal
+9 ; 5=No Act Ins subtotal
+10 ; 6=MBI subtotal
+11 ;
+12 ; Init vars
+13 NEW IBDT,IBPTR,IBTYP,RPTDATA,TQIEN
+14 ;
+15 ; Loop thru the eIV Resp File (#365) by x-ref on Date/Time Resp Created
+16 ; Only count responses for unique HL7 message IDs - filter out
+17 ; unsolicited responses as they artificially inflate the Outgoing Count
+18 SET IBDT=$ORDER(^IBCN(365,"AE",BDT),-1)
+19 FOR
SET IBDT=$ORDER(^IBCN(365,"AE",IBDT))
if IBDT=""!(IBDT>EDT)
QUIT
Begin DoDot:1
+20 SET IBPTR=0
+21 FOR
SET IBPTR=$ORDER(^IBCN(365,"AE",IBDT,IBPTR))
if 'IBPTR
QUIT
Begin DoDot:2
+22 SET TOT=TOT+1
+23 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+24 ; Quit, if response was not O - original
+25 IF $PIECE($GET(^IBCN(365,IBPTR,0)),U,10)'="O"
QUIT
+26 ; Update total
+27 SET $PIECE(RPTDATA,U,1)=$PIECE($GET(RPTDATA),U,1)+1
+28 ; Update extract type total (1,2,3,4)
+29 SET TQIEN=$PIECE($GET(^IBCN(365,IBPTR,0)),U,5)
+30 IF TQIEN=""
QUIT
+31 ; IB*2.0*621
+32 ;S IBTYP=$P($G(^IBCN(365.1,TQIEN,0)),U,10)
+33 SET IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
+34 SET IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
+35 SET IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
+36 IF IBTYP'=""
Begin DoDot:3
+37 IF IBTYP=3
QUIT
+38 ;I IBTYP=1 D Q ;IB*2.0*631/TAZ
+39 ; MBI Request``
IF IBTYP=7
SET $PIECE(RPTDATA,U,6)=$PIECE($GET(RPTDATA),U,6)+1
QUIT
+40 IF ("~1~5~6~"[("~"_IBTYP_"~"))
SET $PIECE(RPTDATA,U,2)=$PIECE($GET(RPTDATA),U,2)+1
QUIT
+41 IF IBTYP=4
Begin DoDot:4
+42 ; EICD Queries
IF IBQUERY="I"
SET $PIECE(RPTDATA,U,4)=$PIECE($GET(RPTDATA),U,4)+1
+43 ; EICD Verification
IF IBQUERY="V"
SET $PIECE(RPTDATA,U,5)=$PIECE($GET(RPTDATA),U,5)+1
End DoDot:4
QUIT
+44 if IBTYP=2
SET $PIECE(RPTDATA,U,3)=$PIECE($GET(RPTDATA),U,3)+1
End DoDot:3
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+45 ;
+46 IF $GET(ZTSTOP)
GOTO OUTX
+47 ;
+48 ; Save data to global array
+49 SET ^TMP($JOB,RTN,"OUT")=$GET(RPTDATA)
+50 ;
OUTX ; OUT exit pt
+1 QUIT
+2 ;
CUR(RTN,BDT,EDT,TOT) ; Current Status - stats - timeframe independent
+1 ; Input params: RTN-routine name as subs in ^TMP($J), **TOT-total recs
+2 ; searched - used only for status checks when the process is queued
+3 ; passed by reference
+4 ; Output vars: Set pcs of ^TMP($J,RTN,"CUR") as follows:
+5 ; 1=total Pending Resps (Transmitted-2)
+6 ; 2=total Queued Inqs (Ready to Transmit-1/Retry-6)
+7 ; 3=total Deferred Inqs (Hold-4)
+8 ; 4=Ins Cos w/o National ID
+9 ; 5=Payers w/eIV locally enabled is NO ;/vd-IB*2*687 - Reworded the description.
+10 ; ; 6=total user action required (symbol'='*' or '#' or '!' or '?' or '-')
+11 ; 6=total user action required (symbol'='#' or '!' or '?' or '-') ;IB*737/DTG stop use of '*' verified
+12 ; 7=total Man. Ver'd Ins Buf entries (symbol='*') ;IB*737/DTG stop use of '*' verified
+13 ; 8=total eIV Processed Ver. (symbol='+')
+14 ; 9=total awaiting processing (symbol='?' or BLANK)
+15 ; 10=total Ins Buf entries w/symbol='#'
+16 ; 11=total Ins Buf entries w/symbol='!'
+17 ; 12=total Ins Buf entries w/symbol='?'
+18 ; 13=total Ins Buf entries w/symbol='-'
+19 ; ; 14=total Ins Buffer entries w/symbol not in ('*','#','!','?','-')
+20 ; 14=total Ins Buffer entries w/symbol not in ('#','!','?','-') ;IB*737/DTG stop use of '*' verified
+21 ; 15=total Ins Buffer entries w/symbol='$'
+22 ; 16=total Ins Buffet entries w/symbol= % ; IB*2.0*621 - Added 16-21
+23 ; 17=total Insurance Buffer
+24 ; 18=Total Appointment
+25 ; 19=total Ele Ins Cov Discovery (EICD)
+26 ; 20=total EICD Triggered Einsurance Verification
+27 ; 21=total MBI Inquiry
+28 ; 22=total IIU Payer 'Received IIU Data' set to NO ;IB*2.0*687
+29 ;
+30 ; ^TMP($J,RTN,"CUR","FLAGS","NE",APP,Payer name,N) = nationally enabled flag timestamp ^ nationally enabled flag setting
+31 ; ^TMP($J,RTN,"CUR","FLAGS","AU",APP,Payer name,N) = auto updated flag timestamp ^ auto update flag setting
+32 ;
+33 ;/ckb-IB*2.0*687 Added APP to incorporate IIU into this report;
+34 ; added IIU Payer 'Received IIU Data' set to NO to the report;
+35 ; corrected references from Active (A) & Trusted (T) to
+36 ; Nationally Enabled (NE) and Auto Update (AU)
+37 ;
+38 ; Init vars
+39 NEW RIEN,TQIEN,ICIEN,IBIEN,RPTDATA,IEN,IBSYMBOL,PIECE,IBSTS,APPIEN
+40 NEW PIEN,TMP,APPDATA,XDT,PDATA
+41 ;
+42 SET RPTDATA=""
+43 ;
+44 ; Responses pending (Transmitted - 2)
+45 SET RIEN=0
+46 FOR
SET RIEN=$ORDER(^IBCN(365,"AC",2,RIEN))
if 'RIEN
QUIT
Begin DoDot:1
+47 SET TOT=TOT+1
+48 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+49 SET $PIECE(RPTDATA,U,1)=$PIECE(RPTDATA,U,1)+1
+50 ; IB*2.0*621
+51 SET TQIEN=$PIECE($GET(^IBCN(365,RIEN,0)),U,5)
+52 IF TQIEN=""
QUIT
+53 SET IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
+54 SET IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
+55 SET IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
+56 IF IBTYP'=""
Begin DoDot:2
+57 IF IBTYP=3
QUIT
+58 ;I IBTYP=1 D Q ;IB*2.0*631
+59 ; MBI Request``
IF IBTYP=7
SET $PIECE(RPTDATA,U,21)=$PIECE($GET(RPTDATA),U,21)+1
QUIT
+60 IF ("~1~5~6~"[("~"_IBTYP_"~"))
SET $PIECE(RPTDATA,U,17)=$PIECE($GET(RPTDATA),U,17)+1
QUIT
End DoDot:2
+61 ; Appointment
if IBTYP=2
SET $PIECE(RPTDATA,U,18)=$PIECE($GET(RPTDATA),U,18)+1
+62 IF IBTYP=4
Begin DoDot:2
+63 ; EICD Queries
IF IBQUERY="I"
SET $PIECE(RPTDATA,U,19)=$PIECE($GET(RPTDATA),U,19)+1
+64 ; EICD Verification
IF IBQUERY="V"
SET $PIECE(RPTDATA,U,20)=$PIECE($GET(RPTDATA),U,20)+1
End DoDot:2
QUIT
+65 ; IB*2.0*621 - End IN Group
End DoDot:1
if $GET(ZTSTOP)
QUIT
+66 ;
+67 IF $GET(ZTSTOP)
GOTO CURX
+68 ;
+69 ; Queued inquiries (Ready to Transmit - 1/Retry - 6) and
+70 ; IB*752/DTG REMOVED ; Deferred inquiries (Hold - 4)
+71 ;F IBSTS=1,6,4 D Q:$G(ZTSTOP)
+72 ; IB*752/DTG remove (4) Deferred
FOR IBSTS=1,6
Begin DoDot:1
+73 SET TQIEN=0
+74 FOR
SET TQIEN=$ORDER(^IBCN(365.1,"AC",IBSTS,TQIEN))
if 'TQIEN
QUIT
Begin DoDot:2
+75 SET TOT=TOT+1
+76 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+77 ; IB*752/DTG remove Deferred
+78 ;I IBSTS'=4 S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1 Q
+79 ;S $P(RPTDATA,U,3)=$P(RPTDATA,U,3)+1
+80 SET $PIECE(RPTDATA,U,2)=$PIECE(RPTDATA,U,2)+1
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+81 ;
+82 IF $GET(ZTSTOP)
GOTO CURX
+83 ;
+84 ; Payer stats
+85 ; Ins cos w/o National ID
+86 SET ICIEN=0
SET $PIECE(RPTDATA,U,4)=0
+87 FOR
SET ICIEN=$ORDER(^DIC(36,ICIEN))
if 'ICIEN
QUIT
Begin DoDot:1
+88 SET TOT=TOT+1
+89 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+90 ; Exclude inactive
+91 SET TMP=$$ACTIVE^IBCNEUT4(ICIEN)
IF 'TMP
QUIT
+92 ; Exclude Medicaid, etc.
+93 IF $$EXCLUDE^IBCNEUT4($PIECE(TMP,U,2))
QUIT
+94 ; Does a NATIONAL ID exist?
+95 ; VA CBO defines 'No National ID' as lack of EDI IDs - fields (#36,3.02) & (#36,3.04) 3/4/14
+96 ; This is *NOT* a check for the 'VA NATIONAL ID' associated with the linked payer
+97 IF ($$GET1^DIQ(36,ICIEN_",",3.02)="")&($$GET1^DIQ(36,ICIEN_",",3.04)="")
SET $PIECE(RPTDATA,U,4)=$PIECE(RPTDATA,U,4)+1
QUIT
+98 QUIT
+99 ; Determine assoc Payer
+100 ;S PIEN=$P($G(^DIC(36,ICIEN,3)),U,10)
+101 ; Missing payer link
+102 ;I 'PIEN S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
+103 ; Does a VA NATIONAL ID exist?
+104 ;I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q
+105 ;S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1
End DoDot:1
if $GET(ZTSTOP)
QUIT
+106 ;
+107 IF $GET(ZTSTOP)
GOTO CURX
+108 ;
+109 ; eIV Payers locally enabled is NO ;/ckb-IB*2.0*687 - Reworded the comment
+110 SET PIEN=0
+111 FOR
SET PIEN=$ORDER(^IBE(365.12,PIEN))
if 'PIEN
QUIT
Begin DoDot:1
+112 SET TOT=TOT+1
+113 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+114 SET PDATA=$GET(^IBE(365.12,PIEN,0))
+115 ; Must have National ID
+116 IF $PIECE(PDATA,U,2)=""
QUIT
+117 ; Get Payer app multiple IEN
+118 ; /ckb-IB*2.0*687 - Replaced the following code.
+119 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
+120 ;S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+121 ; Must have eIV application
+122 ;I 'APPIEN Q
+123 ; Get Active/Trusted flag logs
+124 ;D GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,.RPTDATA)
+125 ;
+126 ;S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
+127 ; Must be Nationally Active
+128 ;I '$P(APPDATA,U,2) Q
+129 ; Must not be Locally Active
+130 ;I $P(APPDATA,U,3) Q
+131 ;S $P(RPTDATA,U,5)=$P(RPTDATA,U,5)+1
+132 ;
+133 NEW IENEIV,IENIIU
+134 KILL APPDATA
+135 SET IENEIV=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+136 SET IENIIU=$$PYRAPP^IBCNEUT5("IIU",PIEN)
+137 ; Payer doesn't have any applications.
IF 'IENEIV
IF 'IENIIU
QUIT
+138 ;'Receive IIU Data' field is set to NO (0), null values are also considered NO.
+139 IF IENIIU
Begin DoDot:2
+140 ; Get the Nationally Enabled/Auto Update flag logs
+141 DO GETFLAGS(PIEN,IENIIU,PDATA,BDT,EDT,"IIU",.RPTDATA)
+142 SET APPDATA=$GET(^IBE(365.12,PIEN,1,IENIIU,0))
+143 ; Must be Nationally Enabled
+144 IF '$PIECE(APPDATA,U,2)
QUIT
+145 IF $PIECE($GET(^IBE(365.12,PIEN,1,IENIIU,5)),U)'=1
SET $PIECE(RPTDATA,U,22)=$PIECE(RPTDATA,U,22)+1
End DoDot:2
+146 IF IENEIV
Begin DoDot:2
+147 ; Get the Nationally Enabled/Auto Update flag logs
+148 DO GETFLAGS(PIEN,IENEIV,PDATA,BDT,EDT,"EIV",.RPTDATA)
+149 SET APPDATA=$GET(^IBE(365.12,PIEN,1,IENEIV,0))
+150 ; Must be Nationally Enabled
+151 IF '$PIECE(APPDATA,U,2)
QUIT
+152 ; Must not be Locally Enabled
+153 IF $PIECE(APPDATA,U,3)
QUIT
+154 SET $PIECE(RPTDATA,U,5)=$PIECE(RPTDATA,U,5)+1
End DoDot:2
End DoDot:1
if $GET(ZTSTOP)
QUIT
+155 ;/ckb-IB*2.0*687 End of new code
+156 ;
+157 IF $GET(ZTSTOP)
GOTO CURX
+158 ;
+159 ; Buffer stats
+160 ; Loop thru the Ins Buffer File (#355.33)
+161 SET IBIEN=0
SET XDT=0
+162 FOR
SET XDT=$ORDER(^IBA(355.33,"AEST","E",XDT))
if XDT=""
QUIT
Begin DoDot:1
+163 FOR
SET IBIEN=$ORDER(^IBA(355.33,"AEST","E",XDT,IBIEN))
if IBIEN=""
QUIT
Begin DoDot:2
+164 SET TOT=TOT+1
+165 IF $DATA(ZTQUEUED)
IF TOT#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+166 SET IBSYMBOL=$$SYMBOL^IBCNBLL(IBIEN)
+167 ; Determine piece to update based on symbol
+168 ; ;('*') = Man. Verified, ('#','!','-','?',blank/null) = eIV Processing
+169 ; ('#','!','-','?',blank/null) = eIV Processing ;IB*737/DTG stop use of '*' verified
+170 ; ('+') = eIV Processed, ('$') = Escalated, Active policy
+171 ; IB*2.0*506/taz Node 15 added.
+172 ; IB*2.0*621/ Node 16 Added.
+173 ;S PIECE=$S(IBSYMBOL="*":7,IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,IBSYMBOL="$":15,IBSYMBOL="%":16,1:14)
+174 ;IB*737/DTG stop use of '*' verified
SET PIECE=$SELECT(IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,IBSYMBOL="$":15,IBSYMBOL="%":16,1:14)
+175 IF PIECE=12!(PIECE=14)
SET $PIECE(RPTDATA,U,9)=$PIECE($GET(RPTDATA),U,9)+1
+176 IF '$TEST
SET $PIECE(RPTDATA,U,6)=$PIECE($GET(RPTDATA),U,6)+1
+177 SET $PIECE(RPTDATA,U,PIECE)=$PIECE($GET(RPTDATA),U,PIECE)+1
End DoDot:2
if $GET(ZTSTOP)
QUIT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+178 ;
+179 IF $GET(ZTSTOP)
GOTO CURX
CURM ;
+1 ; Save data to global
+2 MERGE ^TMP($JOB,RTN,"CUR")=RPTDATA
+3 ;
CURX ; CUR exit point
+1 QUIT
+2 ;
+3 ;/ckb-IB*2.0*687 - GETFLAGS is rewritten to incorporate IIU and improve readability.
+4 ; This function is only called by CUR^IBCNERP8; it is called by IBCNERPC but not used.
GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,APP,RPTDATA) ;
+1 ; PIEN - Payer ien in file 365.12
+2 ; APPIEN - Application ien in subfile 365.121
+3 ; PDATA - 0 node of Payer file entry
+4 ; BDT - Start date/time
+5 ; EDT - End date/time
+6 ; APP - Payer Application EIV or IIU
+7 ; RPTDATA - output array, passed by reference
+8 ;
+9 NEW FLAGS,IEN,PNAME,TYP,TM,VAL,Z
+10 SET PNAME=$PIECE(PDATA,U)
+11 ;to prevent error when called from IBCNERPC
IF '$DATA(APP)
SET APP=0
+12 ; TYP=2 Nationally Enabled Log / TYP=3 Auto-Update Log
+13 FOR TYP=2,3
Begin DoDot:1
+14 SET TM=EDT
SET Z=0
FOR
SET TM=$ORDER(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM),-1)
if TM=""!($$FMDIFF^XLFDT(TM,BDT,2)'>0)
QUIT
Begin DoDot:2
+15 SET IEN=$ORDER(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM,""))
+16 SET VAL=$$EXTERNAL^DILFD("365.121"_TYP,.02,,$PIECE(^IBE(365.12,PIEN,1,APPIEN,TYP,IEN,0),U,2))
+17 SET Z=Z+1
+18 SET RPTDATA("FLAGS",APP,$SELECT(TYP=2:"NE",1:"AU"),PNAME,Z)=$$FMTE^XLFDT(TM,"5ZS")_"^"_VAL
+19 QUIT
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
PYR(RTN,BDT,EDT,TOT) ; Determine Incoming Data
+1 ; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,
+2 ; EDT-end dt/time, **TOT-total records searched - used only for status
+3 ; checks when the process is queued (passed by reference)
+4 ; Output vars: Set ^TMP($J,RTN,"PYR",APP,PAYER NAME,IEN of file 365.12)="" ;IB*2.0*687
+5 ;
+6 ; /ckb-IB*2*687 Added APP to incorporate IIU into this report. Moved from IBCNERP0.
+7 ;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
+8 ;
+9 ;N PIEN,PYR,CREATEDT,APPIEN,APPDATA
+10 NEW PIEN,PYR,CREATEDT,APP,APPIEN,APPDATA
+11 SET PIEN=0
FOR
SET PIEN=$ORDER(^IBE(365.12,PIEN))
if 'PIEN
QUIT
Begin DoDot:1
+12 SET PYR=$PIECE($GET(^IBE(365.12,PIEN,0)),U)
+13 SET TOT=TOT+1
+14 FOR APP="EIV","IIU"
Begin DoDot:2
+15 ; Get the ien of the application
SET APPIEN=+$$PYRAPP^IBCNEUT5(APP,+PIEN)
+16 ; No application for this Payer.
IF 'APPIEN
QUIT
+17 ; Get the Date/Time Created from the Application
+18 SET CREATEDT=$PIECE($GET(^IBE(365.12,PIEN,1,APPIEN,0)),U,13)
+19 IF CREATEDT=""!(CREATEDT<BDT)!(CREATEDT>EDT)
QUIT
+20 ;
+21 ; Get Payer app multiple IEN
+22 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
+23 ;S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PIEN)
+24 ; Must have eIV application
+25 ;I 'APPIEN Q
+26 ;IB*687 -remove Nationally Active check
+27 ;S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
+28 ; Must be Nationally Active
+29 ;I '$P(APPDATA,U,2) Q
+30 ;
+31 SET ^TMP($JOB,RTN,"PYR",APP,PYR,PIEN)=""
+32 QUIT
End DoDot:2
End DoDot:1
+33 QUIT
