IBCNERP9 ;DAOU/BHS - eIV STATISTICAL REPORT PRINT ;12-JUN-2002
;;2.0;INTEGRATED BILLING;**184,271,416,506,528,621,687,737,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance Verification Interface
;
; Input variables from IBCNERP7:
; IBCNERTN = "IBCNERP7"
; **IBCNESPC array ONLY passed by reference
; IBCNESPC("BEGDTM") = Start Date/Time for date/time report range
; IBCNESPC("ENDDTM") = End Date/Time for date/time report range
; IBCNESPC("SECTS") = 1 - All, includes all sections OR
; list of one or more of the following:
; 2 - Outgoing Data, Inquiry Transmission data,
; 3 - Incoming Data, Inquiry Response data,
; 4 - General Data, Insurance Buffer data,
; Communication Failures, Outstanding Inquiries
; IBCNESPC("MM") = "", do not generate MailMan message OR
; MAILGROUP, mailgroup to send MailMan message to
; based on IB site parameter
; Assumes report data exists in ^TMP($J,IBCNERTN,...)
; Based on IBCNESPC("SECTS") parameter the following scratch globals
; will 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 Removing Deferred
; 1 OR contains 4 -->
; ^TMP($J,RTN,"CUR")=TotOutstandingInq^TotInqRetries^...
; TotInqCommFailure^TotInsBufVerified^...
; ManVerifedSubtotal^eIVProcessedSubtotal...
; TotInsBufUnverified^! InsBufSubtotal^...
; ? InsBufSubtotal^- InsBufSubtotal^...
; Other InsBufSubtotal^TQReadyToTransmit^...
; NULL (was Deferred)^TQRetry
; and ^TMP($J,RTN","PYR",APP,PAYER NAME,IEN of file 365.12)="" ;IB*2*687
; IBOUT = "E" for Excel or "R" for report format
;
; ckb-IB*2*687 Added APP to incorporate IIU into this rpt; corrected
; references from Nationally active & locally active to
; Nationally and Locally enabled. Utilized "TXT" to consolidate
; display code of different labels.
Q
;
EN(IBCNERTN,IBCNESPC,IBOUT) ; Entry pt
N CRT,MAXCNT,IBPXT,IBPGC,IBBDT,IBEDT,IBSCT,IBMM,RETRY,OUTINQ,ATTEMPT
N X,Y,DIR,DTOUT,DUOUT,LIN,IBMBI,IBQUERY
;
S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))
S IBSCT=$G(IBCNESPC("SECTS")),IBMM=$G(IBCNESPC("MM"))
;
S (IBPXT,IBPGC,CRT,MAXCNT)=0
;
; Determine IO parameters if output device is NOT MailMan message
I IBMM="" D
. I IOST["C-" S MAXCNT=IOSL-3,CRT=1 Q
. S MAXCNT=IOSL-6,CRT=0
;
D PRINT(IBCNERTN,IBBDT,IBEDT,IBSCT,IBMM,.IBPGC,.IBPXT,MAXCNT,CRT,IBOUT)
I $G(ZTSTOP)!IBPXT G EXIT
I CRT,IBPGC>0,'$D(ZTQUEUED) D G EXIT
. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
;
EXIT ; Exit pt
Q
;
PRINT(RTN,BDT,EDT,SCT,MM,PGC,PXT,MAX,CRT,IBOUT) ; Print data
N APP,EORMSG,NONEMSG,LINECT,DISPDATA,HDRDATA,OFFSET,TMP,DTMRNG,SITE ;IB*2*687
;
S LINECT=0
;
; Build End-Of-Report Message for display
S EORMSG="*** END OF REPORT ***"
S OFFSET=80-$L(EORMSG)\2
S EORMSG=$$FO^IBCNEUT1(EORMSG,OFFSET+$L(EORMSG),"R")
; Build No-Data-Found Message for display
S NONEMSG="* * * N O D A T A F O U N D * * *"
S OFFSET=80-$L(NONEMSG)\2
S NONEMSG=$$FO^IBCNEUT1(NONEMSG,OFFSET+$L(NONEMSG),"R")
; Build Site for display
S SITE=$P($$SITE^VASITE,U,2)
; Build Date/Time Range for display
; Starting date/time
S TMP=$$FMTE^XLFDT(BDT,"5Z")
S DTMRNG=$P(TMP,"@")_" "_$P(TMP,"@",2)
; Ending date/time
S TMP=$$FMTE^XLFDT(EDT,"5Z")
S DTMRNG=DTMRNG_" - "_$P(TMP,"@")_" "_$P(TMP,"@",2)
;
; Print hdr to DISPDATA for MailMan message ONLY
I IBOUT="R" D HEADER(.HDRDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
I MM'="" M DISPDATA=HDRDATA S LINECT=+$O(DISPDATA(""),-1)
I MM="" KILL HDRDATA
;
; If global does not exist - display No Data message
I '$D(^TMP($J,RTN)) S LINECT=LINECT+1,DISPDATA(LINECT)=NONEMSG G PRINT2
;
; Display Outgoing Data - if selected
I SCT=1!(SCT[2) D I PXT!$G(ZTSTOP) G PRINTX
. D DATA(.DISPDATA,.LINECT,RTN,"OUT",MM,IBOUT)
;
; Display Incoming Data - if selected
I SCT=1!(SCT[3) D I PXT!$G(ZTSTOP) G PRINTX
. D DATA(.DISPDATA,.LINECT,RTN,"IN",MM,IBOUT)
;
; Display General Data - if selected
I SCT=1!(SCT[4) D I PXT!$G(ZTSTOP) G PRINTX
. D DATA(.DISPDATA,.LINECT,RTN,"CUR",MM,IBOUT)
. ;ckb-IB*2*687 - Get display data for both EIV and IIU payers
. F APP="EIV","IIU" D
. . D DATA(.DISPDATA,.LINECT,RTN,"PYR",MM,IBOUT)
. . D DATA(.DISPDATA,.LINECT,RTN,"FLG",MM,IBOUT)
;
PRINT2 S LINECT=LINECT+1
S DISPDATA(LINECT)=EORMSG
;
I MM="" D LINE(.DISPDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
; Generate MailMan message, if flag is set
I MM'="" D MSG^IBCNEUT5(MM,"** eIV Statistical Rpt **","DISPDATA(")
;
PRINTX ; PRINT exit pt
Q
;
LINE(DISPDATA,PGC,PXT,MAX,CRT,SITE,DTMRNG,MM) ; Print line of data
N CT,II,ARRAY,NWPG
;
S NWPG=0
S CT=+$O(DISPDATA(""),-1)
I $Y+1+CT>MAX,PGC>1 D HEADER(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM) S NWPG=1 I PXT!$G(ZTSTOP) G LINEX
F II=1:1:CT D Q:PXT!$G(ZTSTOP)
. I $Y+1>MAX!('PGC) D HEADER(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM) S NWPG=1 I PXT!$G(ZTSTOP) Q
. I 'NWPG!(NWPG&($D(DISPDATA(II)))) I $G(DISPDATA(II))'="" W !,?1,DISPDATA(II)
. I NWPG S NWPG=0
LINEX ; LINE exit pt
Q
;
DATA(DISPDATA,LINECT,RTN,TYPE,MM,IBOUT) ; Format lines of data to be printed
; IB*528 - baa : added code to output to Excel
; IB*752 removed DEFINQ from NEW statement
N DASHES,PEND,RPTDATA,CT,INSCOS,PAYERS,QUEINQ,TXT,TYPE1
;
S $P(DASHES,"=",14)="",TYPE1=TYPE ; IB*2*621
I LINECT>0,MM="" S LINECT=LINECT+1,DISPDATA(LINECT)=""
;
; Copy report data to local variable
S RPTDATA=$G(^TMP($J,RTN,TYPE)) ; does not work for "PYR"
; Outgoing and Incoming Totals
I TYPE="OUT"!(TYPE="IN") D S:IBOUT="R" LINECT=LINECT+1,DISPDATA(LINECT)=" " G DATAX ; IB*2*621
. S LINECT=LINECT+1
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1($S(TYPE="OUT":"Outgoing Data (Inquiries Sent)",1:"Incoming Data (Responses Received)"),46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,1),14,"R") ; IB*2*621
. I IBOUT="E" S DISPDATA(LINECT)=$S(TYPE="OUT":"OUTGOING DATA",1:"INCOMING DATA")_U_+$P(RPTDATA,U,1)
. S LINECT=LINECT+1
. I IBOUT="R" S DISPDATA(LINECT)=DASHES ; IB*2*621
. F CT=1:1:5 D ; Updated for IB*2*621
. . N TYPE ;
. . I TYPE1="IN" S TYPE=$S(CT=1:"Insurance Buffer",CT=2:"Appointment",CT=3:"Electronic Insurance Coverage Discovery (EICD)",CT=4:"EICD-Triggered eInsurance Verification",CT=5:"MBI Response")
. . I TYPE1="OUT" S TYPE=$S(CT=1:"Insurance Buffer",CT=2:"Appointment",CT=3:"Electronic Insurance Coverage Discovery (EICD)",CT=4:"EICD-Triggered eInsurance Verification",CT=5:"MBI Inquiry")
. . S LINECT=LINECT+1
. . I IBOUT="E" S DISPDATA(LINECT)=TYPE_U_+$P(RPTDATA,U,CT+1)
. . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TYPE,50)_$$FO^IBCNEUT1(+$P(RPTDATA,U,CT+1),25,"R")
;
; General Data
I TYPE="CUR" D G DATAX
. S LINECT=LINECT+1 ; IB*2*621 - Added Status Label
. I IBOUT="R" S DISPDATA(LINECT)="Current Status",LINECT=LINECT+1,DISPDATA(LINECT)="=============="
. I IBOUT="E" S DISPDATA(LINECT)="CURRENT STATUS"
. ;
. ; IB*2*621 - Updated Responses pending for EICD
. S PEND=+$P(RPTDATA,U,1)
. S LINECT=LINECT+1
. S TXT="Responses Pending"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(PEND,14,"R")
. ;
. S PEND=+$P(RPTDATA,U,17)
. S LINECT=LINECT+1
. S TXT="Insurance Buffer"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
. ;
. S PEND=+$P(RPTDATA,U,18)
. S LINECT=LINECT+1
. S TXT="Appointment"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
. ;
. S PEND=+$P(RPTDATA,U,19)
. S LINECT=LINECT+1
. S TXT="Electronic Insurance Coverage Discovery (EICD)"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
. ;
. S PEND=+$P(RPTDATA,U,20)
. S LINECT=LINECT+1
. S TXT="EICD-Triggered eInsurance Verification"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
. ;
. S PEND=+$P(RPTDATA,U,21)
. S LINECT=LINECT+1
. S TXT="MBI Inquiry"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
. ;
. S QUEINQ=+$P(RPTDATA,U,2)
. S LINECT=LINECT+1
. S TXT="Queued Inquiries"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_QUEINQ
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(QUEINQ,14,"R")
. ;
. ; IB*752/DTG remove Deferred (RPTDATA,U,3)
. ;S DEFINQ=+$P(RPTDATA,U,3)
. ;S LINECT=LINECT+1
. ;S TXT="Deferred Inquiries:"
. ;I IBOUT="E" S DISPDATA(LINECT)=TXT_U_DEFINQ
. ;I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT,46)_$$FO^IBCNEUT1(DEFINQ,14,"R")
. ;
. S INSCOS=+$P(RPTDATA,U,4)
. S LINECT=LINECT+1
. S TXT="Insurance Companies w/o National ID"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_INSCOS
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(INSCOS,14,"R")
. ;
. ;ckb-IB*2*687 - Changed the wording from "Disabled Locally".
. S PAYERS=+$P(RPTDATA,U,5)
. S LINECT=LINECT+1
. S TXT="eIV Payers 'Locally Enabled' is NO"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PAYERS
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(PAYERS,14,"R")
. I IBOUT="R" S LINECT=LINECT+1
. ;
. ;ckb-IB*2*687 - Added this to the report.
. S PAYERS=+$P(RPTDATA,U,22)
. S LINECT=LINECT+1
. S TXT="IIU Payers 'Receive IIU Data' is NO:"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PAYERS
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT,46)_$$FO^IBCNEUT1(PAYERS,14,"R")
. I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
. ;
. ; Insurance Buffer statistics
. S LINECT=LINECT+1
. S TXT="Insurance Buffer Entries:"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_" "_U_($P(RPTDATA,U,6)+$P(RPTDATA,U,9))
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_" ",46)_$$FO^IBCNEUT1(($P(RPTDATA,U,6)+$P(RPTDATA,U,9)),14,"R") ; IB*2*621
. ;
. ; *,+,#,! or - symbol entries - User action required
. ; +,#,! or - symbol entries - User action required ;IB*737/DTG stop use of '*' verified
. S LINECT=LINECT+1
. S TXT="User Action Required"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,6)
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT_": ",46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,6),22,"R")
. I IBOUT="R" F CT=8,15,16,13,10,11 D ; IB*2*621
. . S LINECT=LINECT+1
. . S TYPE=" # of "
. . ;I CT=7 S TXT="* entries (User Verified policy)" ;ckb-IB*2*687 - This line should have been commented out years ago.
. . I CT=8 S TXT="+ entries (Payer indicated Active policy)"
. . I CT=10 S TXT="# entries (Policy status undetermined)"
. . I CT=11 S TXT="! entries (eIV needs user assistance for entry)"
. . I CT=13 S TXT="- entries (Payer indicated Inactive policy)"
. . I CT=15 S TXT="$ entries (Escalated, Active policy)"
. . I CT=16 S TXT="% entries (MBI value received)" ; IB*2*621
. . S TYPE=TYPE_TXT
. . S DISPDATA(LINECT)=$$FO^IBCNEUT1(TYPE,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,CT),19,"R")
. ;
. S LINECT=LINECT+1
. S TXT="Entries Awaiting Processing"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,9)
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT_": ",46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,9),22,"R")
. ;
. S LINECT=LINECT+1
. S TXT="# of ? entries (eIV is waiting for a response)"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,12)
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,12),19,"R")
. ;
. S LINECT=LINECT+1
. S TXT="# of blank entries (yet to be processed or accepted)"
. I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,14)
. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,14),19,"R")
;
S LINECT=LINECT+1 ; IB*2*621-Blank Line
I IBOUT="R" S DISPDATA(LINECT)=" " ; IB*2*621
; New Payers added to File 365.12
;ckb-IB*2*687 - Modified code below to include APP (EIV or IIU)
I TYPE="PYR" I APP="EIV" D G DATAX
. ; Payers added to file 365.12
. D DATAX
. S LINECT=LINECT+1 ; IB*2*621
. I IBOUT="E" S DISPDATA(LINECT)="PAYER ACTIVITY (During Report Date Range)" ; IB*2*621
. I IBOUT="R" S DISPDATA(LINECT)="Payer Activity (During Report Date Range)" ; IB*2*621
. I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="=============="
. S LINECT=LINECT+1
. S DISPDATA(LINECT)="New eIV Payers received:" ; IB*2*621
. S LINECT=LINECT+1
. I IBOUT="R" S DISPDATA(LINECT)="------------------------"
. S LINECT=LINECT+1
. I '$D(^TMP($J,RTN,TYPE,APP)) S DISPDATA(LINECT)=" No new eIV Payers added" Q
. ;ckb-IB*2*687 - Modified the Edit description for New eIV Payers received.
. S DISPDATA(LINECT)=" Please link the associated active insurance companies to these payers at your"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" earliest convenience. Locally enable the payers after you link insurance"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" companies to them. For further details regarding this process, please refer"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" to the Electronic Insurance Verification User Guide."
. D BLDPYR ;IB*2*687
. ;ckb-IB*2*687 Modified FLG from A to NE and T to AU
I TYPE="FLG" I APP="EIV" D G DATAX ; IB*2*621 Added Payer Received
. N DATA,PNAME,Z,FLG
. F FLG="NE","AU" D
. . I FLG="NE" D
. . . I IBOUT="R" S DISPDATA(LINECT)=" "
. . . ;ckb-IB*2*687 - Changed the text to be printed from "National Payers - ACTIVE flag changes at FSC:".
. . . S LINECT=LINECT+1,DISPDATA(LINECT)="eIV Payers - FSC changed the 'Nationally Enabled' field:"
. . . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="--------------------------------------------------------"
. . . Q
. . I FLG="AU" D
. . . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
. . . ;ckb-IB*2*687 - Changed the text to be printed from "Nationally Active Payers - TRUSTED flag changes at FSC:".
. . . S LINECT=LINECT+1,DISPDATA(LINECT)="eIV Payers - FSC changed the 'Auto Update' field:"
. . . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="-------------------------------------------------"
. . . Q
. . I '$D(^TMP($J,RTN,"CUR","FLAGS",APP,FLG)) D Q
. . . S LINECT=LINECT+1,DISPDATA(LINECT)=" No information available",LINECT=LINECT+1
. . D BLDFLG ;ckb-IB*2*687 - added to be used to by eIV and IIU Payers to build flag log info.
. . Q
;ckb-IB*2*687 - Add IIU Payers info to report.
I TYPE="PYR" I APP="IIU" D G DATAX
. S LINECT=LINECT+1
. S DISPDATA(LINECT)="New IIU Payers received:"
. S LINECT=LINECT+1
. I IBOUT="R" S DISPDATA(LINECT)="------------------------"
. S LINECT=LINECT+1
. I '$D(^TMP($J,RTN,TYPE,APP)) S DISPDATA(LINECT)=" No new IIU Payers added" Q
. S DISPDATA(LINECT)=" Please review the payer linking for the associated active insurance companies"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" to these payers at your earliest convenience. To receive incoming IIU records"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" from other VAMCs into your buffer, turn ON the 'Receive IIU Data' field for"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" the payers. For further details regarding this process, please refer to the"
. S LINECT=LINECT+1,DISPDATA(LINECT)=" Electronic Insurance Verification User Guide."
. D BLDPYR
;
I TYPE="FLG" I APP="IIU" D G DATAX
. N DATA,PNAME,Z
. I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
. S DISPDATA(LINECT)="IIU Payers - FSC changed the 'Nationally Enabled' field:"
. I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="--------------------------------------------------------"
. I '$D(^TMP($J,RTN,"CUR","FLAGS",APP,"NE")) D
. . S LINECT=LINECT+1,DISPDATA(LINECT)=" No information available",LINECT=LINECT+1
. . S DISPDATA(LINECT)=" "
. S FLG="NE"
. D BLDFLG
. Q
;ckb-IB*2*687 End of rewrite due to APP variable. All IIU logic is new with this patch.
DATAX ; DATA exit pt
S LINECT=LINECT+1
S DISPDATA(LINECT)=""
Q
;
;ckb - Added with IB*2*687
BLDFLG ; Build the data display of the eIV/IIU Payers flags (Nationally Enabled and/or Auto Update) info.
S PNAME="" F S PNAME=$O(^TMP($J,RTN,"CUR","FLAGS",APP,FLG,PNAME)) Q:PNAME="" D
. S Z="" F S Z=$O(^TMP($J,RTN,"CUR","FLAGS",APP,FLG,PNAME,Z)) Q:Z="" D
. . S DATA=$G(^TMP($J,RTN,"CUR","FLAGS",APP,FLG,PNAME,Z))
. . S LINECT=LINECT+1
. . I IBOUT="E" S DISPDATA(LINECT)=PNAME_U_$P(DATA,U)_U_$P(DATA,U,2)
. . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_PNAME,47)_$$FO^IBCNEUT1($P(DATA,U),19)_" Set: "_$P(DATA,U,2)
Q
;
;ckb - Added with IB*2*687
BLDPYR ; Build the data display of the New eIV/IIU Payers info.
N PYR,PIEN
S PYR="" F S PYR=$O(^TMP($J,RTN,TYPE,APP,PYR)) Q:PYR="" D
. S PIEN="" F S PIEN=$O(^TMP($J,RTN,TYPE,APP,PYR,PIEN)) Q:'PIEN D
. . S LINECT=LINECT+1
. . I IBOUT="E" S DISPDATA(LINECT)=PYR Q
. . I IBOUT="R" S DISPDATA(LINECT)=" "_PYR
Q
;
;ckb IB*2*687-Moved from another routine that is no longer assoc w/ this rpt.
N CT,HDRCT,LIN,HDR
;
; Prompt to print next page for reports to the screen
I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
. I MAX<51 F LIN=1:1:(MAX-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S PXT=1 Q
I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX
;
; Update page ct
S PGC=PGC+1
;
; Update header based on MailMan message flag
S HDRCT=0
S HDRCT=HDRCT+1,HDRDATA(HDRCT)="eIV Statistical Report"_$$FO^IBCNEUT1($$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC,56,"R")
;S HDRDATA(HDRCT)=$$FO^IBCNEUT1(SITE,(80-$L(SITE)\2)+$L(SITE),"R"),HDRCT=HDRCT+1
S HDR="Report Timeframe: "_DTMRNG ; IB*2*621
S HDRCT=HDRCT+1,HDRDATA(HDRCT)=$$FO^IBCNEUT1(HDR,(80-$L(HDR)\2)+$L(HDR),"R") ; IB*2*621
S HDRCT=HDRCT+1,HDRDATA(HDRCT)="" ; IB*2*621
;
I MM S HDRCT=HDRCT+1,HDRDATA(HDRCT)=""
; Only write out Header for non-MailMan message output
I MM="" W @IOF F CT=1:1:HDRCT W !,?1,HDRDATA(CT)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERP9 18728 printed Oct 16, 2024@18:15:46 Page 2
IBCNERP9 ;DAOU/BHS - eIV STATISTICAL REPORT PRINT ;12-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,416,506,528,621,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 variables from IBCNERP7:
+7 ; IBCNERTN = "IBCNERP7"
+8 ; **IBCNESPC array ONLY passed by reference
+9 ; IBCNESPC("BEGDTM") = Start Date/Time for date/time report range
+10 ; IBCNESPC("ENDDTM") = End Date/Time for date/time report range
+11 ; IBCNESPC("SECTS") = 1 - All, includes all sections OR
+12 ; list of one or more of the following:
+13 ; 2 - Outgoing Data, Inquiry Transmission data,
+14 ; 3 - Incoming Data, Inquiry Response data,
+15 ; 4 - General Data, Insurance Buffer data,
+16 ; Communication Failures, Outstanding Inquiries
+17 ; IBCNESPC("MM") = "", do not generate MailMan message OR
+18 ; MAILGROUP, mailgroup to send MailMan message to
+19 ; based on IB site parameter
+20 ; Assumes report data exists in ^TMP($J,IBCNERTN,...)
+21 ; Based on IBCNESPC("SECTS") parameter the following scratch globals
+22 ; will be built
+23 ; 1 OR contains 2 -->
+24 ; ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
+25 ; NonVerifInsExtSubtotal^NoActInsExtSubtotal
+26 ; 1 OR contains 3 -->
+27 ; ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
+28 ; NonVerifInsExtSubtotal^NoActInsExtSubtotal
+29 ; IB*752/DTG Removing Deferred
+30 ; 1 OR contains 4 -->
+31 ; ^TMP($J,RTN,"CUR")=TotOutstandingInq^TotInqRetries^...
+32 ; TotInqCommFailure^TotInsBufVerified^...
+33 ; ManVerifedSubtotal^eIVProcessedSubtotal...
+34 ; TotInsBufUnverified^! InsBufSubtotal^...
+35 ; ? InsBufSubtotal^- InsBufSubtotal^...
+36 ; Other InsBufSubtotal^TQReadyToTransmit^...
+37 ; NULL (was Deferred)^TQRetry
+38 ; and ^TMP($J,RTN","PYR",APP,PAYER NAME,IEN of file 365.12)="" ;IB*2*687
+39 ; IBOUT = "E" for Excel or "R" for report format
+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. Utilized "TXT" to consolidate
+44 ; display code of different labels.
+45 QUIT
+46 ;
EN(IBCNERTN,IBCNESPC,IBOUT) ; Entry pt
+1 NEW CRT,MAXCNT,IBPXT,IBPGC,IBBDT,IBEDT,IBSCT,IBMM,RETRY,OUTINQ,ATTEMPT
+2 NEW X,Y,DIR,DTOUT,DUOUT,LIN,IBMBI,IBQUERY
+3 ;
+4 SET IBBDT=$GET(IBCNESPC("BEGDTM"))
SET IBEDT=$GET(IBCNESPC("ENDDTM"))
+5 SET IBSCT=$GET(IBCNESPC("SECTS"))
SET IBMM=$GET(IBCNESPC("MM"))
+6 ;
+7 SET (IBPXT,IBPGC,CRT,MAXCNT)=0
+8 ;
+9 ; Determine IO parameters if output device is NOT MailMan message
+10 IF IBMM=""
Begin DoDot:1
+11 IF IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
QUIT
+12 SET MAXCNT=IOSL-6
SET CRT=0
End DoDot:1
+13 ;
+14 DO PRINT(IBCNERTN,IBBDT,IBEDT,IBSCT,IBMM,.IBPGC,.IBPXT,MAXCNT,CRT,IBOUT)
+15 IF $GET(ZTSTOP)!IBPXT
GOTO EXIT
+16 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+17 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+18 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
GOTO EXIT
+19 ;
EXIT ; Exit pt
+1 QUIT
+2 ;
PRINT(RTN,BDT,EDT,SCT,MM,PGC,PXT,MAX,CRT,IBOUT) ; Print data
+1 ;IB*2*687
NEW APP,EORMSG,NONEMSG,LINECT,DISPDATA,HDRDATA,OFFSET,TMP,DTMRNG,SITE
+2 ;
+3 SET LINECT=0
+4 ;
+5 ; Build End-Of-Report Message for display
+6 SET EORMSG="*** END OF REPORT ***"
+7 SET OFFSET=80-$LENGTH(EORMSG)\2
+8 SET EORMSG=$$FO^IBCNEUT1(EORMSG,OFFSET+$LENGTH(EORMSG),"R")
+9 ; Build No-Data-Found Message for display
+10 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+11 SET OFFSET=80-$LENGTH(NONEMSG)\2
+12 SET NONEMSG=$$FO^IBCNEUT1(NONEMSG,OFFSET+$LENGTH(NONEMSG),"R")
+13 ; Build Site for display
+14 SET SITE=$PIECE($$SITE^VASITE,U,2)
+15 ; Build Date/Time Range for display
+16 ; Starting date/time
+17 SET TMP=$$FMTE^XLFDT(BDT,"5Z")
+18 SET DTMRNG=$PIECE(TMP,"@")_" "_$PIECE(TMP,"@",2)
+19 ; Ending date/time
+20 SET TMP=$$FMTE^XLFDT(EDT,"5Z")
+21 SET DTMRNG=DTMRNG_" - "_$PIECE(TMP,"@")_" "_$PIECE(TMP,"@",2)
+22 ;
+23 ; Print hdr to DISPDATA for MailMan message ONLY
+24 IF IBOUT="R"
DO HEADER(.HDRDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
+25 IF MM'=""
MERGE DISPDATA=HDRDATA
SET LINECT=+$ORDER(DISPDATA(""),-1)
+26 IF MM=""
KILL HDRDATA
+27 ;
+28 ; If global does not exist - display No Data message
+29 IF '$DATA(^TMP($JOB,RTN))
SET LINECT=LINECT+1
SET DISPDATA(LINECT)=NONEMSG
GOTO PRINT2
+30 ;
+31 ; Display Outgoing Data - if selected
+32 IF SCT=1!(SCT[2)
Begin DoDot:1
+33 DO DATA(.DISPDATA,.LINECT,RTN,"OUT",MM,IBOUT)
End DoDot:1
IF PXT!$GET(ZTSTOP)
GOTO PRINTX
+34 ;
+35 ; Display Incoming Data - if selected
+36 IF SCT=1!(SCT[3)
Begin DoDot:1
+37 DO DATA(.DISPDATA,.LINECT,RTN,"IN",MM,IBOUT)
End DoDot:1
IF PXT!$GET(ZTSTOP)
GOTO PRINTX
+38 ;
+39 ; Display General Data - if selected
+40 IF SCT=1!(SCT[4)
Begin DoDot:1
+41 DO DATA(.DISPDATA,.LINECT,RTN,"CUR",MM,IBOUT)
+42 ;ckb-IB*2*687 - Get display data for both EIV and IIU payers
+43 FOR APP="EIV","IIU"
Begin DoDot:2
+44 DO DATA(.DISPDATA,.LINECT,RTN,"PYR",MM,IBOUT)
+45 DO DATA(.DISPDATA,.LINECT,RTN,"FLG",MM,IBOUT)
End DoDot:2
End DoDot:1
IF PXT!$GET(ZTSTOP)
GOTO PRINTX
+46 ;
PRINT2 SET LINECT=LINECT+1
+1 SET DISPDATA(LINECT)=EORMSG
+2 ;
+3 IF MM=""
DO LINE(.DISPDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
+4 ; Generate MailMan message, if flag is set
+5 IF MM'=""
DO MSG^IBCNEUT5(MM,"** eIV Statistical Rpt **","DISPDATA(")
+6 ;
PRINTX ; PRINT exit pt
+1 QUIT
+2 ;
LINE(DISPDATA,PGC,PXT,MAX,CRT,SITE,DTMRNG,MM) ; Print line of data
+1 NEW CT,II,ARRAY,NWPG
+2 ;
+3 SET NWPG=0
+4 SET CT=+$ORDER(DISPDATA(""),-1)
+5 IF $Y+1+CT>MAX
IF PGC>1
DO HEADER(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
SET NWPG=1
IF PXT!$GET(ZTSTOP)
GOTO LINEX
+6 FOR II=1:1:CT
Begin DoDot:1
+7 IF $Y+1>MAX!('PGC)
DO HEADER(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
SET NWPG=1
IF PXT!$GET(ZTSTOP)
QUIT
+8 IF 'NWPG!(NWPG&($DATA(DISPDATA(II))))
IF $GET(DISPDATA(II))'=""
WRITE !,?1,DISPDATA(II)
+9 IF NWPG
SET NWPG=0
End DoDot:1
if PXT!$GET(ZTSTOP)
QUIT
LINEX ; LINE exit pt
+1 QUIT
+2 ;
DATA(DISPDATA,LINECT,RTN,TYPE,MM,IBOUT) ; Format lines of data to be printed
+1 ; IB*528 - baa : added code to output to Excel
+2 ; IB*752 removed DEFINQ from NEW statement
+3 NEW DASHES,PEND,RPTDATA,CT,INSCOS,PAYERS,QUEINQ,TXT,TYPE1
+4 ;
+5 ; IB*2*621
SET $PIECE(DASHES,"=",14)=""
SET TYPE1=TYPE
+6 IF LINECT>0
IF MM=""
SET LINECT=LINECT+1
SET DISPDATA(LINECT)=""
+7 ;
+8 ; Copy report data to local variable
+9 ; does not work for "PYR"
SET RPTDATA=$GET(^TMP($JOB,RTN,TYPE))
+10 ; Outgoing and Incoming Totals
+11 ; IB*2*621
IF TYPE="OUT"!(TYPE="IN")
Begin DoDot:1
+12 SET LINECT=LINECT+1
+13 ; IB*2*621
IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1($SELECT(TYPE="OUT":"Outgoing Data (Inquiries Sent)",1:"Incoming Data (Responses Received)"),46)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,1),14,"R")
+14 IF IBOUT="E"
SET DISPDATA(LINECT)=$SELECT(TYPE="OUT":"OUTGOING DATA",1:"INCOMING DATA")_U_+$PIECE(RPTDATA,U,1)
+15 SET LINECT=LINECT+1
+16 ; IB*2*621
IF IBOUT="R"
SET DISPDATA(LINECT)=DASHES
+17 ; Updated for IB*2*621
FOR CT=1:1:5
Begin DoDot:2
+18 ;
NEW TYPE
+19 IF TYPE1="IN"
SET TYPE=$SELECT(CT=1:"Insurance Buffer",CT=2:"Appointment",CT=3:"Electronic Insurance Coverage Discovery (EICD)",CT=4:"EICD-Triggered eInsurance Verification",CT=5:"MBI Response")
+20 IF TYPE1="OUT"
SET TYPE=$SELECT(CT=1:"Insurance Buffer",CT=2:"Appointment",CT=3:"Electronic Insurance Coverage Discovery (EICD)",CT=4:"EICD-Triggered eInsurance Verification",CT=5:"MBI Inquiry")
+21 SET LINECT=LINECT+1
+22 IF IBOUT="E"
SET DISPDATA(LINECT)=TYPE_U_+$PIECE(RPTDATA,U,CT+1)
+23 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TYPE,50)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,CT+1),25,"R")
End DoDot:2
End DoDot:1
if IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" "
GOTO DATAX
+24 ;
+25 ; General Data
+26 IF TYPE="CUR"
Begin DoDot:1
+27 ; IB*2*621 - Added Status Label
SET LINECT=LINECT+1
+28 IF IBOUT="R"
SET DISPDATA(LINECT)="Current Status"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)="=============="
+29 IF IBOUT="E"
SET DISPDATA(LINECT)="CURRENT STATUS"
+30 ;
+31 ; IB*2*621 - Updated Responses pending for EICD
+32 SET PEND=+$PIECE(RPTDATA,U,1)
+33 SET LINECT=LINECT+1
+34 SET TXT="Responses Pending"
+35 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PEND
+36 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(PEND,14,"R")
+37 ;
+38 SET PEND=+$PIECE(RPTDATA,U,17)
+39 SET LINECT=LINECT+1
+40 SET TXT="Insurance Buffer"
+41 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PEND
+42 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
+43 ;
+44 SET PEND=+$PIECE(RPTDATA,U,18)
+45 SET LINECT=LINECT+1
+46 SET TXT="Appointment"
+47 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PEND
+48 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
+49 ;
+50 SET PEND=+$PIECE(RPTDATA,U,19)
+51 SET LINECT=LINECT+1
+52 SET TXT="Electronic Insurance Coverage Discovery (EICD)"
+53 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PEND
+54 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
+55 ;
+56 SET PEND=+$PIECE(RPTDATA,U,20)
+57 SET LINECT=LINECT+1
+58 SET TXT="EICD-Triggered eInsurance Verification"
+59 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PEND
+60 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
+61 ;
+62 SET PEND=+$PIECE(RPTDATA,U,21)
+63 SET LINECT=LINECT+1
+64 SET TXT="MBI Inquiry"
+65 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PEND
+66 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
+67 ;
+68 SET QUEINQ=+$PIECE(RPTDATA,U,2)
+69 SET LINECT=LINECT+1
+70 SET TXT="Queued Inquiries"
+71 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_QUEINQ
+72 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(QUEINQ,14,"R")
+73 ;
+74 ; IB*752/DTG remove Deferred (RPTDATA,U,3)
+75 ;S DEFINQ=+$P(RPTDATA,U,3)
+76 ;S LINECT=LINECT+1
+77 ;S TXT="Deferred Inquiries:"
+78 ;I IBOUT="E" S DISPDATA(LINECT)=TXT_U_DEFINQ
+79 ;I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT,46)_$$FO^IBCNEUT1(DEFINQ,14,"R")
+80 ;
+81 SET INSCOS=+$PIECE(RPTDATA,U,4)
+82 SET LINECT=LINECT+1
+83 SET TXT="Insurance Companies w/o National ID"
+84 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_INSCOS
+85 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(INSCOS,14,"R")
+86 ;
+87 ;ckb-IB*2*687 - Changed the wording from "Disabled Locally".
+88 SET PAYERS=+$PIECE(RPTDATA,U,5)
+89 SET LINECT=LINECT+1
+90 SET TXT="eIV Payers 'Locally Enabled' is NO"
+91 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PAYERS
+92 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(PAYERS,14,"R")
+93 IF IBOUT="R"
SET LINECT=LINECT+1
+94 ;
+95 ;ckb-IB*2*687 - Added this to the report.
+96 SET PAYERS=+$PIECE(RPTDATA,U,22)
+97 SET LINECT=LINECT+1
+98 SET TXT="IIU Payers 'Receive IIU Data' is NO:"
+99 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_PAYERS
+100 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT,46)_$$FO^IBCNEUT1(PAYERS,14,"R")
+101 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" "
+102 ;
+103 ; Insurance Buffer statistics
+104 SET LINECT=LINECT+1
+105 SET TXT="Insurance Buffer Entries:"
+106 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_" "_U_($PIECE(RPTDATA,U,6)+$PIECE(RPTDATA,U,9))
+107 ; IB*2*621
IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_" ",46)_$$FO^IBCNEUT1(($PIECE(RPTDATA,U,6)+$PIECE(RPTDATA,U,9)),14,"R")
+108 ;
+109 ; *,+,#,! or - symbol entries - User action required
+110 ; +,#,! or - symbol entries - User action required ;IB*737/DTG stop use of '*' verified
+111 SET LINECT=LINECT+1
+112 SET TXT="User Action Required"
+113 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_+$PIECE(RPTDATA,U,6)
+114 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT_": ",46)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,6),22,"R")
+115 ; IB*2*621
IF IBOUT="R"
FOR CT=8,15,16,13,10,11
Begin DoDot:2
+116 SET LINECT=LINECT+1
+117 SET TYPE=" # of "
+118 ;I CT=7 S TXT="* entries (User Verified policy)" ;ckb-IB*2*687 - This line should have been commented out years ago.
+119 IF CT=8
SET TXT="+ entries (Payer indicated Active policy)"
+120 IF CT=10
SET TXT="# entries (Policy status undetermined)"
+121 IF CT=11
SET TXT="! entries (eIV needs user assistance for entry)"
+122 IF CT=13
SET TXT="- entries (Payer indicated Inactive policy)"
+123 IF CT=15
SET TXT="$ entries (Escalated, Active policy)"
+124 ; IB*2*621
IF CT=16
SET TXT="% entries (MBI value received)"
+125 SET TYPE=TYPE_TXT
+126 SET DISPDATA(LINECT)=$$FO^IBCNEUT1(TYPE,56)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,CT),19,"R")
End DoDot:2
+127 ;
+128 SET LINECT=LINECT+1
+129 SET TXT="Entries Awaiting Processing"
+130 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_+$PIECE(RPTDATA,U,9)
+131 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT_": ",46)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,9),22,"R")
+132 ;
+133 SET LINECT=LINECT+1
+134 SET TXT="# of ? entries (eIV is waiting for a response)"
+135 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_+$PIECE(RPTDATA,U,12)
+136 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,56)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,12),19,"R")
+137 ;
+138 SET LINECT=LINECT+1
+139 SET TXT="# of blank entries (yet to be processed or accepted)"
+140 IF IBOUT="E"
SET DISPDATA(LINECT)=TXT_U_+$PIECE(RPTDATA,U,14)
+141 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_TXT,56)_$$FO^IBCNEUT1(+$PIECE(RPTDATA,U,14),19,"R")
End DoDot:1
GOTO DATAX
+142 ;
+143 ; IB*2*621-Blank Line
SET LINECT=LINECT+1
+144 ; IB*2*621
IF IBOUT="R"
SET DISPDATA(LINECT)=" "
+145 ; New Payers added to File 365.12
+146 ;ckb-IB*2*687 - Modified code below to include APP (EIV or IIU)
+147 IF TYPE="PYR"
IF APP="EIV"
Begin DoDot:1
+148 ; Payers added to file 365.12
+149 DO DATAX
+150 ; IB*2*621
SET LINECT=LINECT+1
+151 ; IB*2*621
IF IBOUT="E"
SET DISPDATA(LINECT)="PAYER ACTIVITY (During Report Date Range)"
+152 ; IB*2*621
IF IBOUT="R"
SET DISPDATA(LINECT)="Payer Activity (During Report Date Range)"
+153 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)="=============="
+154 SET LINECT=LINECT+1
+155 ; IB*2*621
SET DISPDATA(LINECT)="New eIV Payers received:"
+156 SET LINECT=LINECT+1
+157 IF IBOUT="R"
SET DISPDATA(LINECT)="------------------------"
+158 SET LINECT=LINECT+1
+159 IF '$DATA(^TMP($JOB,RTN,TYPE,APP))
SET DISPDATA(LINECT)=" No new eIV Payers added"
QUIT
+160 ;ckb-IB*2*687 - Modified the Edit description for New eIV Payers received.
+161 SET DISPDATA(LINECT)=" Please link the associated active insurance companies to these payers at your"
+162 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" earliest convenience. Locally enable the payers after you link insurance"
+163 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" companies to them. For further details regarding this process, please refer"
+164 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" to the Electronic Insurance Verification User Guide."
+165 ;IB*2*687
DO BLDPYR
+166 ;ckb-IB*2*687 Modified FLG from A to NE and T to AU
End DoDot:1
GOTO DATAX
+167 ; IB*2*621 Added Payer Received
IF TYPE="FLG"
IF APP="EIV"
Begin DoDot:1
+168 NEW DATA,PNAME,Z,FLG
+169 FOR FLG="NE","AU"
Begin DoDot:2
+170 IF FLG="NE"
Begin DoDot:3
+171 IF IBOUT="R"
SET DISPDATA(LINECT)=" "
+172 ;ckb-IB*2*687 - Changed the text to be printed from "National Payers - ACTIVE flag changes at FSC:".
+173 SET LINECT=LINECT+1
SET DISPDATA(LINECT)="eIV Payers - FSC changed the 'Nationally Enabled' field:"
+174 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)="--------------------------------------------------------"
+175 QUIT
End DoDot:3
+176 IF FLG="AU"
Begin DoDot:3
+177 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" "
+178 ;ckb-IB*2*687 - Changed the text to be printed from "Nationally Active Payers - TRUSTED flag changes at FSC:".
+179 SET LINECT=LINECT+1
SET DISPDATA(LINECT)="eIV Payers - FSC changed the 'Auto Update' field:"
+180 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)="-------------------------------------------------"
+181 QUIT
End DoDot:3
+182 IF '$DATA(^TMP($JOB,RTN,"CUR","FLAGS",APP,FLG))
Begin DoDot:3
+183 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" No information available"
SET LINECT=LINECT+1
End DoDot:3
QUIT
+184 ;ckb-IB*2*687 - added to be used to by eIV and IIU Payers to build flag log info.
DO BLDFLG
+185 QUIT
End DoDot:2
End DoDot:1
GOTO DATAX
+186 ;ckb-IB*2*687 - Add IIU Payers info to report.
+187 IF TYPE="PYR"
IF APP="IIU"
Begin DoDot:1
+188 SET LINECT=LINECT+1
+189 SET DISPDATA(LINECT)="New IIU Payers received:"
+190 SET LINECT=LINECT+1
+191 IF IBOUT="R"
SET DISPDATA(LINECT)="------------------------"
+192 SET LINECT=LINECT+1
+193 IF '$DATA(^TMP($JOB,RTN,TYPE,APP))
SET DISPDATA(LINECT)=" No new IIU Payers added"
QUIT
+194 SET DISPDATA(LINECT)=" Please review the payer linking for the associated active insurance companies"
+195 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" to these payers at your earliest convenience. To receive incoming IIU records"
+196 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" from other VAMCs into your buffer, turn ON the 'Receive IIU Data' field for"
+197 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" the payers. For further details regarding this process, please refer to the"
+198 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" Electronic Insurance Verification User Guide."
+199 DO BLDPYR
End DoDot:1
GOTO DATAX
+200 ;
+201 IF TYPE="FLG"
IF APP="IIU"
Begin DoDot:1
+202 NEW DATA,PNAME,Z
+203 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" "
+204 SET DISPDATA(LINECT)="IIU Payers - FSC changed the 'Nationally Enabled' field:"
+205 IF IBOUT="R"
SET LINECT=LINECT+1
SET DISPDATA(LINECT)="--------------------------------------------------------"
+206 IF '$DATA(^TMP($JOB,RTN,"CUR","FLAGS",APP,"NE"))
Begin DoDot:2
+207 SET LINECT=LINECT+1
SET DISPDATA(LINECT)=" No information available"
SET LINECT=LINECT+1
+208 SET DISPDATA(LINECT)=" "
End DoDot:2
+209 SET FLG="NE"
+210 DO BLDFLG
+211 QUIT
End DoDot:1
GOTO DATAX
+212 ;ckb-IB*2*687 End of rewrite due to APP variable. All IIU logic is new with this patch.
DATAX ; DATA exit pt
+1 SET LINECT=LINECT+1
+2 SET DISPDATA(LINECT)=""
+3 QUIT
+4 ;
+5 ;ckb - Added with IB*2*687
BLDFLG ; Build the data display of the eIV/IIU Payers flags (Nationally Enabled and/or Auto Update) info.
+1 SET PNAME=""
FOR
SET PNAME=$ORDER(^TMP($JOB,RTN,"CUR","FLAGS",APP,FLG,PNAME))
if PNAME=""
QUIT
Begin DoDot:1
+2 SET Z=""
FOR
SET Z=$ORDER(^TMP($JOB,RTN,"CUR","FLAGS",APP,FLG,PNAME,Z))
if Z=""
QUIT
Begin DoDot:2
+3 SET DATA=$GET(^TMP($JOB,RTN,"CUR","FLAGS",APP,FLG,PNAME,Z))
+4 SET LINECT=LINECT+1
+5 IF IBOUT="E"
SET DISPDATA(LINECT)=PNAME_U_$PIECE(DATA,U)_U_$PIECE(DATA,U,2)
+6 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_PNAME,47)_$$FO^IBCNEUT1($PIECE(DATA,U),19)_" Set: "_$PIECE(DATA,U,2)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
+9 ;ckb - Added with IB*2*687
BLDPYR ; Build the data display of the New eIV/IIU Payers info.
+1 NEW PYR,PIEN
+2 SET PYR=""
FOR
SET PYR=$ORDER(^TMP($JOB,RTN,TYPE,APP,PYR))
if PYR=""
QUIT
Begin DoDot:1
+3 SET PIEN=""
FOR
SET PIEN=$ORDER(^TMP($JOB,RTN,TYPE,APP,PYR,PIEN))
if 'PIEN
QUIT
Begin DoDot:2
+4 SET LINECT=LINECT+1
+5 IF IBOUT="E"
SET DISPDATA(LINECT)=PYR
QUIT
+6 IF IBOUT="R"
SET DISPDATA(LINECT)=" "_PYR
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
+1 ;ckb IB*2*687-Moved from another routine that is no longer assoc w/ this rpt.
+2 NEW CT,HDRCT,LIN,HDR
+3 ;
+4 ; Prompt to print next page for reports to the screen
+5 IF CRT
IF PGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+6 IF MAX<51
FOR LIN=1:1:(MAX-$Y)
WRITE !
+7 SET DIR(0)="E"
DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXT=1
QUIT
End DoDot:1
IF PXT
GOTO HEADERX
+9 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET ZTSTOP=1
GOTO HEADERX
+10 ;
+11 ; Update page ct
+12 SET PGC=PGC+1
+13 ;
+14 ; Update header based on MailMan message flag
+15 SET HDRCT=0
+16 SET HDRCT=HDRCT+1
SET HDRDATA(HDRCT)="eIV Statistical Report"_$$FO^IBCNEUT1($$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC,56,"R")
+17 ;S HDRDATA(HDRCT)=$$FO^IBCNEUT1(SITE,(80-$L(SITE)\2)+$L(SITE),"R"),HDRCT=HDRCT+1
+18 ; IB*2*621
SET HDR="Report Timeframe: "_DTMRNG
+19 ; IB*2*621
SET HDRCT=HDRCT+1
SET HDRDATA(HDRCT)=$$FO^IBCNEUT1(HDR,(80-$LENGTH(HDR)\2)+$LENGTH(HDR),"R")
+20 ; IB*2*621
SET HDRCT=HDRCT+1
SET HDRDATA(HDRCT)=""
+21 ;
+22 IF MM
SET HDRCT=HDRCT+1
SET HDRDATA(HDRCT)=""
+23 ; Only write out Header for non-MailMan message output
+24 IF MM=""
WRITE @IOF
FOR CT=1:1:HDRCT
WRITE !,?1,HDRDATA(CT)
+25 ;
+1 QUIT
