Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNERP9

IBCNERP9.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; eIV - Insurance Verification Interface
  1.  ;
  1.  ; Input variables from IBCNERP7:
  1.  ;  IBCNERTN = "IBCNERP7"
  1.  ; **IBCNESPC array ONLY passed by reference
  1.  ;  IBCNESPC("BEGDTM") = Start Date/Time for date/time report range
  1.  ;  IBCNESPC("ENDDTM") = End Date/Time for date/time report range
  1.  ;  IBCNESPC("SECTS") = 1 - All, includes all sections OR
  1.  ;   list of one or more of the following:
  1.  ;   2 - Outgoing Data, Inquiry Transmission data,
  1.  ;   3 - Incoming Data, Inquiry Response data,
  1.  ;   4 - General Data, Insurance Buffer data,
  1.  ;   Communication Failures, Outstanding Inquiries
  1.  ;   IBCNESPC("MM") = "", do not generate MailMan message OR
  1.  ;                    MAILGROUP, mailgroup to send MailMan message to
  1.  ;                               based on IB site parameter
  1.  ;   Assumes report data exists in ^TMP($J,IBCNERTN,...)
  1.  ;   Based on IBCNESPC("SECTS") parameter the following scratch globals
  1.  ;   will be built
  1.  ;   1 OR contains 2 --> 
  1.  ;    ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
  1.  ;                       NonVerifInsExtSubtotal^NoActInsExtSubtotal
  1.  ;   1 OR contains 3 --> 
  1.  ;    ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
  1.  ;                       NonVerifInsExtSubtotal^NoActInsExtSubtotal
  1.  ; IB*752/DTG Removing Deferred
  1.  ;   1 OR contains 4 -->
  1.  ;    ^TMP($J,RTN,"CUR")=TotOutstandingInq^TotInqRetries^...
  1.  ;                       TotInqCommFailure^TotInsBufVerified^...
  1.  ;                       ManVerifedSubtotal^eIVProcessedSubtotal...
  1.  ;                       TotInsBufUnverified^! InsBufSubtotal^...
  1.  ;                       ? InsBufSubtotal^- InsBufSubtotal^...
  1.  ;                       Other InsBufSubtotal^TQReadyToTransmit^...
  1.  ;                       NULL (was Deferred)^TQRetry
  1.  ;    and ^TMP($J,RTN","PYR",APP,PAYER NAME,IEN of file 365.12)="" ;IB*2*687
  1.  ;    IBOUT = "E" for Excel or "R" for report format
  1.  ;
  1.  ;  ckb-IB*2*687  Added APP to incorporate IIU into this rpt; corrected
  1.  ;           references from Nationally active & locally active to
  1.  ;           Nationally and Locally enabled. Utilized "TXT" to consolidate
  1.  ;           display code of different labels.
  1.  Q
  1.  ;
  1. EN(IBCNERTN,IBCNESPC,IBOUT) ; Entry pt
  1.  N CRT,MAXCNT,IBPXT,IBPGC,IBBDT,IBEDT,IBSCT,IBMM,RETRY,OUTINQ,ATTEMPT
  1.  N X,Y,DIR,DTOUT,DUOUT,LIN,IBMBI,IBQUERY
  1.  ;
  1.  S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))
  1.  S IBSCT=$G(IBCNESPC("SECTS")),IBMM=$G(IBCNESPC("MM"))
  1.  ;
  1.  S (IBPXT,IBPGC,CRT,MAXCNT)=0
  1.  ;
  1.  ; Determine IO parameters if output device is NOT MailMan message
  1.  I IBMM="" D
  1.  . I IOST["C-" S MAXCNT=IOSL-3,CRT=1 Q
  1.  . S MAXCNT=IOSL-6,CRT=0
  1.  ;
  1.  D PRINT(IBCNERTN,IBBDT,IBEDT,IBSCT,IBMM,.IBPGC,.IBPXT,MAXCNT,CRT,IBOUT)
  1.  I $G(ZTSTOP)!IBPXT G EXIT
  1.  I CRT,IBPGC>0,'$D(ZTQUEUED) D  G EXIT
  1.  . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  ;
  1. EXIT ; Exit pt
  1.  Q
  1.  ;
  1. PRINT(RTN,BDT,EDT,SCT,MM,PGC,PXT,MAX,CRT,IBOUT) ; Print data
  1.  N APP,EORMSG,NONEMSG,LINECT,DISPDATA,HDRDATA,OFFSET,TMP,DTMRNG,SITE ;IB*2*687
  1.  ;
  1.  S LINECT=0
  1.  ;
  1.  ; Build End-Of-Report Message for display
  1.  S EORMSG="*** END OF REPORT ***"
  1.  S OFFSET=80-$L(EORMSG)\2
  1.  S EORMSG=$$FO^IBCNEUT1(EORMSG,OFFSET+$L(EORMSG),"R")
  1.  ; Build No-Data-Found Message for display
  1.  S NONEMSG="* * * N O  D A T A  F O U N D * * *"
  1.  S OFFSET=80-$L(NONEMSG)\2
  1.  S NONEMSG=$$FO^IBCNEUT1(NONEMSG,OFFSET+$L(NONEMSG),"R")
  1.  ; Build Site for display
  1.  S SITE=$P($$SITE^VASITE,U,2)
  1.  ; Build Date/Time Range for display
  1.  ;  Starting date/time
  1.  S TMP=$$FMTE^XLFDT(BDT,"5Z")
  1.  S DTMRNG=$P(TMP,"@")_" "_$P(TMP,"@",2)
  1.  ;  Ending date/time
  1.  S TMP=$$FMTE^XLFDT(EDT,"5Z")
  1.  S DTMRNG=DTMRNG_" - "_$P(TMP,"@")_" "_$P(TMP,"@",2)
  1.  ;
  1.  ; Print hdr to DISPDATA for MailMan message ONLY
  1.  I IBOUT="R" D HEADER(.HDRDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
  1.  I MM'="" M DISPDATA=HDRDATA S LINECT=+$O(DISPDATA(""),-1)
  1.  I MM="" KILL HDRDATA
  1.  ;
  1.  ; If global does not exist - display No Data message
  1.  I '$D(^TMP($J,RTN)) S LINECT=LINECT+1,DISPDATA(LINECT)=NONEMSG G PRINT2
  1.  ;
  1.  ; Display Outgoing Data - if selected
  1.  I SCT=1!(SCT[2) D  I PXT!$G(ZTSTOP) G PRINTX
  1.  . D DATA(.DISPDATA,.LINECT,RTN,"OUT",MM,IBOUT)
  1.  ;
  1.  ; Display Incoming Data - if selected
  1.  I SCT=1!(SCT[3) D  I PXT!$G(ZTSTOP) G PRINTX
  1.  . D DATA(.DISPDATA,.LINECT,RTN,"IN",MM,IBOUT)
  1.  ;
  1.  ; Display General Data - if selected
  1.  I SCT=1!(SCT[4) D  I PXT!$G(ZTSTOP) G PRINTX
  1.  . D DATA(.DISPDATA,.LINECT,RTN,"CUR",MM,IBOUT)
  1.  . ;ckb-IB*2*687 - Get display data for both EIV and IIU payers
  1.  . F APP="EIV","IIU" D
  1.  . . D DATA(.DISPDATA,.LINECT,RTN,"PYR",MM,IBOUT)
  1.  . . D DATA(.DISPDATA,.LINECT,RTN,"FLG",MM,IBOUT)
  1.  ;
  1. PRINT2 S LINECT=LINECT+1
  1.  S DISPDATA(LINECT)=EORMSG
  1.  ;
  1.  I MM="" D LINE(.DISPDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
  1.  ; Generate MailMan message, if flag is set
  1.  I MM'="" D MSG^IBCNEUT5(MM,"** eIV Statistical Rpt **","DISPDATA(")
  1.  ;
  1. PRINTX ; PRINT exit pt
  1.  Q
  1.  ;
  1. LINE(DISPDATA,PGC,PXT,MAX,CRT,SITE,DTMRNG,MM) ; Print line of data
  1.  N CT,II,ARRAY,NWPG
  1.  ;
  1.  S NWPG=0
  1.  S CT=+$O(DISPDATA(""),-1)
  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
  1.  F II=1:1:CT D  Q:PXT!$G(ZTSTOP)
  1.  . I $Y+1>MAX!('PGC) D HEADER(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM) S NWPG=1 I PXT!$G(ZTSTOP) Q
  1.  . I 'NWPG!(NWPG&($D(DISPDATA(II)))) I $G(DISPDATA(II))'="" W !,?1,DISPDATA(II)
  1.  . I NWPG S NWPG=0
  1. LINEX ; LINE exit pt
  1.  Q
  1.  ;
  1. DATA(DISPDATA,LINECT,RTN,TYPE,MM,IBOUT) ; Format lines of data to be printed
  1.  ; IB*528 - baa : added code to output to Excel
  1.  ; IB*752 removed DEFINQ from NEW statement
  1.  N DASHES,PEND,RPTDATA,CT,INSCOS,PAYERS,QUEINQ,TXT,TYPE1
  1.  ;
  1.  S $P(DASHES,"=",14)="",TYPE1=TYPE ; IB*2*621
  1.  I LINECT>0,MM="" S LINECT=LINECT+1,DISPDATA(LINECT)=""
  1.  ;
  1.  ; Copy report data to local variable
  1.  S RPTDATA=$G(^TMP($J,RTN,TYPE))      ; does not work for "PYR"
  1.  ; Outgoing and Incoming Totals
  1.  I TYPE="OUT"!(TYPE="IN") D  S:IBOUT="R" LINECT=LINECT+1,DISPDATA(LINECT)=" " G DATAX  ; IB*2*621 
  1.  . S LINECT=LINECT+1
  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 
  1.  . I IBOUT="E" S DISPDATA(LINECT)=$S(TYPE="OUT":"OUTGOING DATA",1:"INCOMING DATA")_U_+$P(RPTDATA,U,1)
  1.  . S LINECT=LINECT+1
  1.  . I IBOUT="R" S DISPDATA(LINECT)=DASHES ; IB*2*621
  1.  . F CT=1:1:5 D  ; Updated for IB*2*621
  1.  . . N TYPE ; 
  1.  . . 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")
  1.  . . 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")
  1.  . . S LINECT=LINECT+1
  1.  . . I IBOUT="E" S DISPDATA(LINECT)=TYPE_U_+$P(RPTDATA,U,CT+1)
  1.  . . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TYPE,50)_$$FO^IBCNEUT1(+$P(RPTDATA,U,CT+1),25,"R")
  1.  ;
  1.  ; General Data
  1.  I TYPE="CUR" D  G DATAX
  1.  . S LINECT=LINECT+1 ; IB*2*621 - Added Status Label
  1.  . I IBOUT="R" S DISPDATA(LINECT)="Current Status",LINECT=LINECT+1,DISPDATA(LINECT)="=============="
  1.  . I IBOUT="E" S DISPDATA(LINECT)="CURRENT STATUS"
  1.  . ;
  1.  . ; IB*2*621 - Updated Responses pending for EICD
  1.  . S PEND=+$P(RPTDATA,U,1)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Responses Pending"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(PEND,14,"R")
  1.  . ;
  1.  . S PEND=+$P(RPTDATA,U,17)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Insurance Buffer"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
  1.  . ;
  1.  . S PEND=+$P(RPTDATA,U,18)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Appointment"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
  1.  . ;
  1.  . S PEND=+$P(RPTDATA,U,19)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Electronic Insurance Coverage Discovery (EICD)"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
  1.  . ;
  1.  . S PEND=+$P(RPTDATA,U,20)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="EICD-Triggered eInsurance Verification"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
  1.  . ;
  1.  . S PEND=+$P(RPTDATA,U,21)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="MBI Inquiry"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PEND
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TXT,60)_$$FO^IBCNEUT1(PEND,15,"R")
  1.  . ;
  1.  . S QUEINQ=+$P(RPTDATA,U,2)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Queued Inquiries"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_QUEINQ
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(QUEINQ,14,"R")
  1.  . ;
  1.  . ; IB*752/DTG remove Deferred (RPTDATA,U,3)
  1.  . ;S DEFINQ=+$P(RPTDATA,U,3)
  1.  . ;S LINECT=LINECT+1
  1.  . ;S TXT="Deferred Inquiries:"
  1.  . ;I IBOUT="E" S DISPDATA(LINECT)=TXT_U_DEFINQ
  1.  . ;I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT,46)_$$FO^IBCNEUT1(DEFINQ,14,"R")
  1.  . ;
  1.  . S INSCOS=+$P(RPTDATA,U,4)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Insurance Companies w/o National ID"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_INSCOS
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(INSCOS,14,"R")
  1.  . ;
  1.  . ;ckb-IB*2*687 - Changed the wording from "Disabled Locally".
  1.  . S PAYERS=+$P(RPTDATA,U,5)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="eIV Payers 'Locally Enabled' is NO"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PAYERS
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT_":",46)_$$FO^IBCNEUT1(PAYERS,14,"R")
  1.  . I IBOUT="R" S LINECT=LINECT+1
  1.  . ;
  1.  . ;ckb-IB*2*687 - Added this to the report.
  1.  . S PAYERS=+$P(RPTDATA,U,22)
  1.  . S LINECT=LINECT+1
  1.  . S TXT="IIU Payers 'Receive IIU Data' is NO:"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_PAYERS
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(TXT,46)_$$FO^IBCNEUT1(PAYERS,14,"R")
  1.  . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
  1.  . ;
  1.  . ; Insurance Buffer statistics
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Insurance Buffer Entries:"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_" "_U_($P(RPTDATA,U,6)+$P(RPTDATA,U,9))
  1.  . 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
  1.  . ;
  1.  . ; *,+,#,! or -  symbol entries - User action required
  1.  . ; +,#,! or -  symbol entries - User action required  ;IB*737/DTG stop use of '*' verified
  1.  . S LINECT=LINECT+1
  1.  . S TXT="User Action Required"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,6)
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("  "_TXT_": ",46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,6),22,"R")
  1.  . I IBOUT="R" F CT=8,15,16,13,10,11 D  ; IB*2*621
  1.  . . S LINECT=LINECT+1
  1.  . . S TYPE="    # of "
  1.  . . ;I CT=7 S TXT="* entries (User Verified policy)" ;ckb-IB*2*687 - This line should have been commented out years ago.
  1.  . . I CT=8 S TXT="+ entries (Payer indicated Active policy)"
  1.  . . I CT=10 S TXT="# entries (Policy status undetermined)"
  1.  . . I CT=11 S TXT="! entries (eIV needs user assistance for entry)"
  1.  . . I CT=13 S TXT="- entries (Payer indicated Inactive policy)"
  1.  . . I CT=15 S TXT="$ entries (Escalated, Active policy)"
  1.  . . I CT=16 S TXT="% entries (MBI value received)" ; IB*2*621
  1.  . . S TYPE=TYPE_TXT
  1.  . . S DISPDATA(LINECT)=$$FO^IBCNEUT1(TYPE,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,CT),19,"R")
  1.  . ;
  1.  . S LINECT=LINECT+1
  1.  . S TXT="Entries Awaiting Processing"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,9)
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("  "_TXT_": ",46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,9),22,"R")
  1.  . ;
  1.  . S LINECT=LINECT+1
  1.  . S TXT="# of ? entries (eIV is waiting for a response)"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,12)
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("    "_TXT,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,12),19,"R")
  1.  . ;
  1.  . S LINECT=LINECT+1
  1.  . S TXT="# of blank entries (yet to be processed or accepted)"
  1.  . I IBOUT="E" S DISPDATA(LINECT)=TXT_U_+$P(RPTDATA,U,14)
  1.  . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("    "_TXT,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,14),19,"R")
  1.  ;
  1.  S LINECT=LINECT+1 ; IB*2*621-Blank Line 
  1.  I IBOUT="R" S DISPDATA(LINECT)=" " ; IB*2*621 
  1.  ; New Payers added to File 365.12
  1.  ;ckb-IB*2*687 - Modified code below to include APP (EIV or IIU)
  1.  I TYPE="PYR" I APP="EIV" D  G DATAX
  1.  . ; Payers added to file 365.12
  1.  . D DATAX
  1.  . S LINECT=LINECT+1 ; IB*2*621
  1.  . I IBOUT="E" S DISPDATA(LINECT)="PAYER ACTIVITY (During Report Date Range)" ; IB*2*621
  1.  . I IBOUT="R" S DISPDATA(LINECT)="Payer Activity (During Report Date Range)" ; IB*2*621
  1.  . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="=============="
  1.  . S LINECT=LINECT+1
  1.  . S DISPDATA(LINECT)="New eIV Payers received:" ; IB*2*621
  1.  . S LINECT=LINECT+1
  1.  . I IBOUT="R" S DISPDATA(LINECT)="------------------------"
  1.  . S LINECT=LINECT+1
  1.  . I '$D(^TMP($J,RTN,TYPE,APP)) S DISPDATA(LINECT)=" No new eIV Payers added" Q
  1.  . ;ckb-IB*2*687 - Modified the Edit description for New eIV Payers received.
  1.  . S DISPDATA(LINECT)=" Please link the associated active insurance companies to these payers at your"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" earliest convenience. Locally enable the payers after you link insurance"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" companies to them. For further details regarding this process, please refer"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" to the Electronic Insurance Verification User Guide."
  1.  . D BLDPYR ;IB*2*687
  1.  . ;ckb-IB*2*687 Modified FLG from A to NE and T to AU
  1.  I TYPE="FLG" I APP="EIV" D  G DATAX ; IB*2*621 Added Payer Received
  1.  . N DATA,PNAME,Z,FLG
  1.  . F FLG="NE","AU" D
  1.  . . I FLG="NE" D
  1.  . . . I IBOUT="R" S DISPDATA(LINECT)=" "
  1.  . . . ;ckb-IB*2*687 - Changed the text to be printed from "National Payers - ACTIVE flag changes at FSC:".
  1.  . . . S LINECT=LINECT+1,DISPDATA(LINECT)="eIV Payers - FSC changed the 'Nationally Enabled' field:"
  1.  . . . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="--------------------------------------------------------"
  1.  . . . Q
  1.  . . I FLG="AU" D
  1.  . . . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
  1.  . . . ;ckb-IB*2*687 - Changed the text to be printed from "Nationally Active Payers - TRUSTED flag changes at FSC:".
  1.  . . . S LINECT=LINECT+1,DISPDATA(LINECT)="eIV Payers - FSC changed the 'Auto Update' field:"
  1.  . . . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="-------------------------------------------------"
  1.  . . . Q
  1.  . . I '$D(^TMP($J,RTN,"CUR","FLAGS",APP,FLG)) D  Q
  1.  . . . S LINECT=LINECT+1,DISPDATA(LINECT)=" No information available",LINECT=LINECT+1
  1.  . . D BLDFLG ;ckb-IB*2*687 - added to be used to by eIV and IIU Payers to build flag log info.
  1.  . . Q
  1.  ;ckb-IB*2*687 - Add IIU Payers info to report.
  1.  I TYPE="PYR" I APP="IIU" D  G DATAX
  1.  . S LINECT=LINECT+1
  1.  . S DISPDATA(LINECT)="New IIU Payers received:"
  1.  . S LINECT=LINECT+1
  1.  . I IBOUT="R" S DISPDATA(LINECT)="------------------------"
  1.  . S LINECT=LINECT+1
  1.  . I '$D(^TMP($J,RTN,TYPE,APP)) S DISPDATA(LINECT)=" No new IIU Payers added" Q
  1.  . S DISPDATA(LINECT)=" Please review the payer linking for the associated active insurance companies"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" to these payers at your earliest convenience. To receive incoming IIU records"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" from other VAMCs into your buffer, turn ON the 'Receive IIU Data' field for"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" the payers. For further details regarding this process, please refer to the"
  1.  . S LINECT=LINECT+1,DISPDATA(LINECT)=" Electronic Insurance Verification User Guide."
  1.  . D BLDPYR
  1.  ;
  1.  I TYPE="FLG" I APP="IIU" D  G DATAX
  1.  . N DATA,PNAME,Z
  1.  . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
  1.  . S DISPDATA(LINECT)="IIU Payers - FSC changed the 'Nationally Enabled' field:"
  1.  . I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)="--------------------------------------------------------"
  1.  . I '$D(^TMP($J,RTN,"CUR","FLAGS",APP,"NE")) D
  1.  . . S LINECT=LINECT+1,DISPDATA(LINECT)=" No information available",LINECT=LINECT+1
  1.  . . S DISPDATA(LINECT)=" "
  1.  . S FLG="NE"
  1.  . D BLDFLG
  1.  . Q
  1.  ;ckb-IB*2*687 End of rewrite due to APP variable. All IIU logic is new with this patch.
  1. DATAX ; DATA exit pt
  1.  S LINECT=LINECT+1
  1.  S DISPDATA(LINECT)=""
  1.  Q
  1.  ;
  1.  ;ckb - Added with IB*2*687
  1. BLDFLG ; Build the data display of the eIV/IIU Payers flags (Nationally Enabled and/or Auto Update) info.
  1.  S PNAME="" F  S PNAME=$O(^TMP($J,RTN,"CUR","FLAGS",APP,FLG,PNAME)) Q:PNAME=""  D
  1.  . S Z="" F  S Z=$O(^TMP($J,RTN,"CUR","FLAGS",APP,FLG,PNAME,Z)) Q:Z=""  D
  1.  . . S DATA=$G(^TMP($J,RTN,"CUR","FLAGS",APP,FLG,PNAME,Z))
  1.  . . S LINECT=LINECT+1
  1.  . . I IBOUT="E" S DISPDATA(LINECT)=PNAME_U_$P(DATA,U)_U_$P(DATA,U,2)
  1.  . . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_PNAME,47)_$$FO^IBCNEUT1($P(DATA,U),19)_" Set: "_$P(DATA,U,2)
  1.  Q
  1.  ; 
  1.  ;ckb - Added with IB*2*687
  1. BLDPYR ; Build the data display of the New eIV/IIU Payers info. 
  1.  N PYR,PIEN
  1.  S PYR="" F  S PYR=$O(^TMP($J,RTN,TYPE,APP,PYR)) Q:PYR=""  D
  1.  . S PIEN="" F  S PIEN=$O(^TMP($J,RTN,TYPE,APP,PYR,PIEN)) Q:'PIEN  D
  1.  . . S LINECT=LINECT+1
  1.  . . I IBOUT="E" S DISPDATA(LINECT)=PYR Q
  1.  . . I IBOUT="R" S DISPDATA(LINECT)="   "_PYR
  1.  Q
  1.  ;
  1.  ;ckb IB*2*687-Moved from another routine that is no longer assoc w/ this rpt.
  1.  N CT,HDRCT,LIN,HDR
  1.  ;
  1.  ; Prompt to print next page for reports to the screen
  1.  I CRT,PGC>0,'$D(ZTQUEUED) D  I PXT G HEADERX
  1.  . I MAX<51 F LIN=1:1:(MAX-$Y) W !
  1.  . S DIR(0)="E" D ^DIR K DIR
  1.  . I $D(DTOUT)!$D(DUOUT) S PXT=1 Q
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX
  1.  ;
  1.  ; Update page ct
  1.  S PGC=PGC+1
  1.  ;
  1.  ; Update header based on MailMan message flag
  1.  S HDRCT=0
  1.  S HDRCT=HDRCT+1,HDRDATA(HDRCT)="eIV Statistical Report"_$$FO^IBCNEUT1($$FMTE^XLFDT($$NOW^XLFDT,1)_"  Page: "_PGC,56,"R")
  1.  ;S HDRDATA(HDRCT)=$$FO^IBCNEUT1(SITE,(80-$L(SITE)\2)+$L(SITE),"R"),HDRCT=HDRCT+1
  1.  S HDR="Report Timeframe: "_DTMRNG ; IB*2*621 
  1.  S HDRCT=HDRCT+1,HDRDATA(HDRCT)=$$FO^IBCNEUT1(HDR,(80-$L(HDR)\2)+$L(HDR),"R") ; IB*2*621 
  1.  S HDRCT=HDRCT+1,HDRDATA(HDRCT)="" ; IB*2*621 
  1.  ;
  1.  I MM S HDRCT=HDRCT+1,HDRDATA(HDRCT)=""
  1.  ; Only write out Header for non-MailMan message output
  1.  I MM="" W @IOF F CT=1:1:HDRCT W !,?1,HDRDATA(CT)
  1.  ;
  1. HEADERX ; HEADER exit pt
  1.  Q