IBCNERPD ;DAOU/RO - INSURANCE COMPANY LINK REPORT ;AUG-2003
;;2.0;INTEGRATED BILLING;**184,252,416,521,528,595,602,687,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance Verification Interface
;
; IB*2.0*687 - split this report out from another report(rewriting it). We reused
; this routine that the old report no longer needs. Therefore, any changes based
; on the patches prior to IB*2.0*687 will no longer apply to this code. You will
; not find any references to them below.
;
; Input parameters: N/A
; Other relevant variables ZTSAVED for queueing:
; IBCNERTN="IBCNERPD" (current routine name for queueing the COMPILE process)
; IBCNESPD("ITYPE")=Ins Company type (1-Unlinked Insurance Companies, 2-Linked Insurance Companies)
; IBCNESPD("IMAT")=Partial matching Ins carriers
; IBCNESPD("IBOUT")=Output Format ('E'- Excel, 'R' - Report)
; IBCNESPD("ISORT")=Primary Sort (1-Insurance Company Name, 2-Payer Name, 3-VA National Payer ID)
;
Q
;
EN ; Main entry pt
; Init vars
N IBCNERTN
S IBCNERTN="IBCNERPD"
;
W @IOF
;IB*2*687/DTG - Add IIU to the report message display
W !,"Insurance Company Link Report",!
W !,"In order for an Insurance Company to be eligible for electronic insurance"
W !,"eligibility communications via the eIV software or to transmit active"
W !,"insurance to another VAMC via IIU, the Insurance Company needs to be"
W !,"linked to an appropriate payer from the National EDI Payer list."
W !,"The National EDI Payer list contains the names of the payers that are"
W !,"currently participating with the eIV and/or IIU process."
W !!,"This report option provides information to assist with finding unlinked"
W !,"insurance companies or payers, which can subsequently be linked through the"
W !,"INSURANCE COMPANY EDIT option."
;
R10 ; Prompt to select linked vs unlinked insurance companies report option
N IBCNESPD,DEST,IBOUT,POP,STOP,ZTQUEUED,ZTREQ,ZTSTOP
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S STOP=0
;
S DIR(0)="S^1:Unlinked insurance companies;2:Linked insurance companies"
S DIR("A")="Select type of companies to display"
S DIR("?",1)=" 1 - Only insurance companies that are not currently linked to a payer"
S DIR("?")=" 2 - Only insurance companies that are currently linked to a payer"
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G EXIT
S IBCNESPD("ITYPE")=Y
I Y=1 S IBCNESPD("ISORT")=1 ; If Unlinked report the sort defaults to the primary sort and skip the sort prompt.
;
;IB*752/TAZ - Modified prompt to add Select Ins Co.
R15 ;Prompt for All, Keyword search or Select Ins Co.
;
N DIR,X,Y,DIRUT
W !
S DIR(0)="S^1:ALL insurance companies;2:Keyword search in insurance companies;3:Select insurance companies"
S DIR("A")="Select companies to display"
S DIR("?",1)=" Enter 1 - Select ALL insurance companies"
S DIR("?",2)=" Enter 2 - Text entered into the search keyword field will"
S DIR("?",3)=" result in the report selecting all insurance"
S DIR("?",4)=" companies that contain the entered text in the"
S DIR("?",5)=" insurance company name."
S DIR("?",6)=" Enter 3 - Individually select insurance companies"
S DIR("?")=" (multiple companies allowed)"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) S Y="" S STOP=1 G:$$STOP^IBCNERP1 EXIT G R10
I Y=1 S IBCNESPD("IMAT")="" G R30
I Y=2 G R20
G R25
;
; IB*752/TAZ - Modified for Select Ins Co.
R20 ; Prompt for Insurance Company Search
N DIR,X,Y,DIRUT
;
W !!,"Text entered into the search keyword field will result in"
W !,"the report selecting all insurance companies that contain"
W !,"the entered text in the insurance company name."
W !
S DIR(0)="F"
S DIR("A")="Enter an insurance company search keyword"
S DIR("?",1)=" Enter a keyword to search insurance company names that"
S DIR("?",2)=" contain the keyword. Examples of keyword: ('CIGNA' would"
S DIR("?",3)=" return CIGNA, CIGNA HICN, NATIONAL CIGNA, REGION 1 CIGNA"
S DIR("?")=" and any others with the term 'CIGNA' in it)"
D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) S Y="" S STOP=1 G:$$STOP^IBCNERP1 EXIT G R15
S IBCNESPD("IMAT")=Y
G R30
;
; IB*752/TAZ - Modified for Select Ins Co.
R25 ;Initialize Prompt for insurance companies.
N ARRAY
;
R26 ; Prompt for multiple insurance companies
;
D INSOCAS^IBCNINSC(.ARRAY)
;
I $G(ARRAY)="^" S STOP=1 G:$$STOP^IBCNERP1 EXIT G R15
I '$G(ARRAY) W !,"This is a required response. Enter '^' to exit" G R26
;
S ARRAY=""
M IBCNESPD("IMAT")=ARRAY
;
R30 ; Prompt to allow users to select output format
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S IBCNESPD("ISORT")=$S(IBCNESPD("ITYPE")=1:1,1:"")
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR K DIR
I $D(DIRUT) S STOP=1
I STOP S IBCNESPD("ISORT")="" G:$$STOP^IBCNERP1 EXIT G R15
S (IBOUT,IBCNESPD("IBOUT"))=Y
;
; If the report is in EXCEL format, set the sort to the primary sort and skip the Sort Prompt.
I IBCNESPD("IBOUT")="E" S IBCNESPD("ISORT")=1
; If Unlinked Report or EXCEL format, this skips over SORT prompt.
I IBCNESPD("ITYPE")=1!$G(IBCNESPD("ISORT"))=1 G R50
;
R40 ; Prompt to allow users to select primary sort
N DIR,X,Y,DIRUT
;
S DIR(0)="S^1:Insurance Company Name;2:Payer Name;3:VA National Payer ID"
S DIR("A")="Select the primary sort field"
S DIR("B")=1
S DIR("?")=" Select the data field by which this report should be primarily sorted."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G:$$STOP^IBCNERP1 EXIT G R30
S IBCNESPD("ISORT")=Y
;
R50 ; Proceed to compilation of the data and then generate the output of the report.
I '$D(ZTQUEUED),IBOUT="R" D
. W ! I IBCNESPD("ITYPE")=2 W !,"*** This report is 132 characters wide ***",!
I IBOUT="E" W !!!,"*** To avoid wrapping, enter '0;256;999' at the 'DEVICE' prompt. ***",!
D DEVICE(IBCNERTN,.IBCNESPD)
;IB*752/TAZ - When ^ entered, don't return to prompts.
;I STOP D G @DEST
;. I $$STOP^IBCNERP1 S DEST="EXIT" Q
;. I IBCNESPD("ITYPE")=1 S DEST="R30" Q
;. I IBCNESPD("IBOUT")="E" S DEST="R30" Q
;. S DEST="R40"
;
EXIT ; Exit pt
Q
;
DEVICE(IBCNERTN,IBCNESPD) ; Device Handler and possible TaskManager calls
; Input params:
; IBCNERTN = Routine name for ^TMP($J,...
; IBCNESPD = Array passed by ref of the report params
; IBOUT = "R" for Report format or "E" for Excel format
;
N POP,ZTDESC,ZTRTN,ZTSAVE
;
S ZTRTN="COMPILE^IBCNERPD("""_IBCNERTN_""",.IBCNESPD)"
S ZTDESC="IBCNE Insurance Company Link Report"
S ZTSAVE("IBCNESPD(")=""
S ZTSAVE("IBCNERTN")=""
S ZTSAVE("IBOUT")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
;IB*752/TAZ - STOP Variable no longer required since not moving to previous prompts.
;I POP S STOP=1
Q
;
COMPILE(IBCNERTN,IBCNESPD) ;
; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
; Input params:
; IBCNERTN = Routine name for ^TMP($J,...
; IBCNESPD = Array passed by ref of the report params
;
; Init scratch globals
K ^TMP($J,IBCNERTN)
; Compile Data
D COMPDATA(IBCNERTN,.IBCNESPD)
; Print Data
I '$G(ZTSTOP) D OUTPUT(IBCNERTN,.IBCNESPD)
; Close device
D ^%ZISC
; Kill scratch globals
K ^TMP($J,IBCNERTN)
; Purge task record
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
COMPDATA(IBCNERTN,IBCNESPD) ; Compile data
N IBI,IBGRP,IBMAT,IBINAME,IBINS,IBPY,IBPYR,IBSORT,IBTYP
N IBELOACT,IBENAACT,IBIADDR,IBICITY,IBIINST,IBINAACT,IBIPROF,IBISTATE,IBIZIP
N APPEIV,APPIENS,APPIIU,IBPINST,IBPPROF,IBPVAID,IBPYARY,IBRPT,SORT1,SORT2,SORT3
;
I '$D(ZTQUEUED),$G(IOST)["C-",IBOUT="R" W !!,"Compiling report data ..."
;
; Kill scratch globals
K ^TMP($J,IBCNERTN)
;
S IBTYP=$G(IBCNESPD("ITYPE"))
S IBSORT=$G(IBCNESPD("ISORT"))
; IB*752/TAZ - Modified for Select Ins Co.
M IBMAT=IBCNESPD("IMAT")
S (SORT1,SORT2,SORT3)=""
;
; Loop thru the Insurance company file
S IBINS=0
F S IBINS=$O(^DIC(36,IBINS)) Q:'IBINS D Q:$G(ZTSTOP)
. I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 Q
. S IBINAME=$$GET1^DIQ(36,IBINS,.01,"I")
. I IBINAME="" Q
. I IBMAT'="",'$F($$UP^XLFSTR(IBINAME),$$UP^XLFSTR(IBMAT)) Q ; ICR #10104
. ; IB*752/TAZ - Modified for Select Ins Co.
. I $D(IBMAT)>10,'$D(IBMAT(IBINS)) Q ;IB*743/TAZ - Not a selected insurance co.
. ; Get active group count
. S (IBI,IBGRP)=0 F S IBI=$O(^IBA(355.3,"B",IBINS,IBI)) Q:'IBI I '$$GET1^DIQ(355.3,IBI,.11,"I") S IBGRP=IBGRP+1
. ;
. S (IBENAACT,IBELOACT,IBINAACT,IBPPROF,IBPINST,IBPYR,IBPVAID)=""
. ; Get PROF ID, INST ID and address from Insurance file
. S IBIPROF=$$GET1^DIQ(36,IBINS,3.02,"I") ;Ins co PROF ID
. S IBIINST=$$GET1^DIQ(36,IBINS,3.04,"I") ;Ins co INST ID
. S IBIADDR=$$GET1^DIQ(36,IBINS,.111,"I"),IBIADDR=$E(IBIADDR,1,35)
. S IBICITY=$$GET1^DIQ(36,IBINS,.114,"I"),IBICITY=$E(IBICITY,1,25)
. S IBISTATE=$$GET1^DIQ(5,+$$GET1^DIQ(36,IBINS,.115,"I"),1)
. S IBIZIP=$$GET1^DIQ(36,IBINS,.116,"I")
. ; Get payer
. S IBPY=$$GET1^DIQ(36,IBINS,3.10,"I")
. ; If Unlinked Report and there is a Payer, quit.
. I IBTYP=1,IBPY'="" Q
. ; If Linked Report and there isn't a Payer, quit.
. I IBTYP=2,IBPY="" Q
. ; Linked Report, get data from the Payer File (#365.12)
. I IBTYP=2 D
. . S IBPYR=$$GET1^DIQ(365.12,IBPY,.01,"I") ;Payer Name
. . S IBPVAID=$$GET1^DIQ(365.12,IBPY,.02,"I") ;VA National ID
. . S IBPPROF=$$GET1^DIQ(365.12,IBPY,.05,"I") ;PROF ID (eligibility)
. . S IBPINST=$$GET1^DIQ(365.12,IBPY,.06,"I") ;INST ID
. . ; Get application info
. . K IBPYARY
. . D PAYER^IBCNINSU(IBPY,,"**","I",.IBPYARY)
. . ; Payer EIV app
. . S APPEIV=$$PYRAPP^IBCNEUT5("EIV",IBPY)
. . I APPEIV'="" D
. . . S APPIENS=""_APPEIV_","_IBPY_","_""
. . . S IBENAACT=IBPYARY(365.121,APPIENS,.02,"I")
. . . S IBENAACT=$S(IBENAACT=1:"YES",1:"NO")
. . . S IBELOACT=IBPYARY(365.121,APPIENS,.03,"I")
. . . S IBELOACT=$S(IBELOACT=1:"YES",1:"NO")
. . ; Payer IIU app
. . S APPIIU=$$PYRAPP^IBCNEUT5("IIU",IBPY)
. . I APPIIU'="" D
. . . S APPIENS=""_APPIIU_","_IBPY_","_""
. . . S IBINAACT=IBPYARY(365.121,APPIENS,.02,"I")
. . . S IBINAACT=$S(IBINAACT=1:"YES",1:"NO")
. . ; Linked Report - SORT fields based upon the SORT that was chosen
. . ; IBSORT=1 equals the Primary Sort sequence: IBINAME,IBPYR,IBPVAID
. . ; IBSORT=2 equals the Payer Sort sequence: IBPYR,IBINAME,IBPVAID
. . ; IBSORT=3 equals the VA ID Sort sequence: IBPVAID,IBINAME,IBPYR
. . I IBSORT=1 S SORT1=IBINAME,SORT2=IBPYR,SORT3=IBPVAID
. . I IBSORT=2 S SORT1=IBPYR,SORT2=IBINAME,SORT3=IBPVAID
. . I IBSORT=3 S SORT1=IBPVAID,SORT2=IBINAME,SORT3=IBPYR
. . I SORT1="" S SORT1=" "
. I IBOUT="E" S SORT1=IBINAME,SORT2=IBPYR,SORT3=IBPVAID
. ;
. ; The Unlinked Report doesn't contain Payer info
. I IBTYP=1 S (SORT1,SORT2,SORT3)=$S(IBINAME'="":IBINAME,1:" ")
. ;
. ; The Unlinked report only uses (IBGRP-IBIZIP). The REPORT format uses all fields
. S IBRPT=IBINAME_U_IBGRP_U_IBIPROF_U_IBIINST_U_IBIADDR_U_IBICITY_U_IBISTATE_U_IBIZIP
. S IBRPT=IBRPT_U_IBPYR_U_IBPVAID_U_IBENAACT_U_IBINAACT_U_IBELOACT_U_IBPPROF_U_IBPINST
. S ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,IBINS)=IBRPT
Q
;
OUTPUT(IBCNERTN,IBCNESPD) ; Sets IO params for printing
N IBMAT,IBPGC,IBPXT,IBSORT,IBTYP
N CRT,DIR,DTOUT,DUOUT,LIN,MAXCNT,X,Y,ZZ
;
S IBTYP=$G(IBCNESPD("ITYPE"))
S IBSORT=$G(IBCNESPD("ISORT"))
; IB*752/TAZ - Modified for Select Ins Co.
M IBMAT=IBCNESPD("IMAT")
;
S (CRT,IBPGC,IBPXT,MAXCNT)=0 ;S (IBPXT,IBPGC)=0
;
; Determine IO params
I "^R^E^"'[(U_$G(IBOUT)_U) S IBOUT="R"
I IOST["C-" S MAXCNT=IOSL-3,CRT=1
E S MAXCNT=IOSL-6,CRT=0
D PRINT(IBCNERTN,IBTYP,IBSORT,.IBPGC,.IBPXT,MAXCNT,CRT,IBOUT)
I $G(ZTSTOP)!IBPXT G OUTPUTX
I CRT,IBPGC>0,'$D(ZTQUEUED) D
. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
I IBOUT="E",CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR ; End of Excel Report
OUTPUTX ; Exit pt
Q
;
PRINT(RTN,IBTYP,SRT,PGC,PXT,MAX,CRT,IBOUT) ; Print data
; Input: RTN="IBCENRPB", PGC=page ct,
; PXT=exit flg, MAX=max line ct/pg,
; CRT=1/0, IBOUT="R"/"E"
N CNT,DASH,EORMSG,NONEMSG,SORT1,SORT2,SORT3,SPACES
S EORMSG="*** END OF REPORT ***"
S NONEMSG="* * * N O D A T A F O U N D * * *"
S $P(DASH,"-",133)="",$P(SPACES," ",132)=""
;
;Excel header
I IBOUT="E" D EHDR
;
; If No Data
I '$D(^TMP($J,RTN)) D HEADER:(IBOUT="R") W !,?(80-$L(NONEMSG)\2),NONEMSG,!!
;
S SORT1="" F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:PXT!$G(ZTSTOP)
. S SORT2="" F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:PXT!$G(ZTSTOP)
. . S SORT3="" F S SORT3=$O(^TMP($J,RTN,SORT1,SORT2,SORT3)) Q:SORT3="" D Q:PXT!$G(ZTSTOP)
. . . S CNT="" F S CNT=$O(^TMP($J,RTN,SORT1,SORT2,SORT3,CNT)) Q:CNT="" D Q:PXT!$G(ZTSTOP)
. . . . K DISPDATA ; Init disp
. . . . D DATA(.DISPDATA),LINE(.DISPDATA)
;
I $G(ZTSTOP)!PXT G PRINTEX
I IBOUT="R" D
. I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTEX
W !,?(80-$L(EORMSG)\2),EORMSG
PRINTEX ;
Q
;
DATA(DISPDATA) ; Build display lines
N ADDRESS,I,LCT,RPTDATA,ZIPCODE
; Merge into local variable
M RPTDATA=^TMP($J,RTN,SORT1,SORT2,SORT3,CNT)
;
; Format Zip Codes, add a "-" after the first 5 digits and before the last 4 digits (99999-9999)
S ZIPCODE=$E($P(RPTDATA,U,8),1,5)
I $L($P(RPTDATA,U,8))>5 S ZIPCODE=$E($P(RPTDATA,U,8),1,5)_"-"_$E($P(RPTDATA,U,8),6,9)
;
; Excel format for Unlinked and Linked Reports
I IBOUT="E" D Q
. S LCT=1,DISPDATA(1)=$P(RPTDATA,U)_U_$P(RPTDATA,U,5)_U_$P(RPTDATA,U,6)
. S DISPDATA(1)=DISPDATA(1)_U_$P(RPTDATA,U,7)_U_ZIPCODE
. S DISPDATA(1)=DISPDATA(1)_U_$P(RPTDATA,U,2)_U_$P(RPTDATA,U,3)_U_$P(RPTDATA,U,4)
. I IBTYP=2 D
. . F I=9:1:$L(RPTDATA,U) S DISPDATA(1)=DISPDATA(1)_U_$P(RPTDATA,U,I)
;
; Report format (Address(35), City(25), State(2) Zip Code
S ADDRESS=$E($P(RPTDATA,U,5),1,35)_" "_$E($P(RPTDATA,U,6),1,25)_", "_$$LJ^XLFSTR($P(RPTDATA,U,7),"2T")_$E(SPACES,1,1)_$$LJ^XLFSTR(ZIPCODE,"10T")
;
; Unlinked Report
I IBTYP=1 D
. ; Line 1 - Ins co, # Active Groups, Claim Prof EDI#, Claim Inst EDI#
. S DISPDATA(1)=$$LJ^XLFSTR($P(RPTDATA,U),"30T")_$E(SPACES,1,2)_$$RJ^XLFSTR($P(RPTDATA,U,2),5)
. S DISPDATA(1)=DISPDATA(1)_$E(SPACES,1,18)_$$RJ^XLFSTR($P(RPTDATA,U,3),5)
. S DISPDATA(1)=DISPDATA(1)_$E(SPACES,1,12)_$$RJ^XLFSTR($P(RPTDATA,U,4),5)
. ; line 2 - Ins co Address
. S DISPDATA(2)=$E(SPACES,1,9)_ADDRESS
. ; line 3 - blank
. S DISPDATA(3)=" "
; Linked Report
I IBTYP=2 D
. ; Line 1 - Ins Co(30),# Active Grps, Address line 1, City, ST, Zip, Prof/Inst EDI#
. S DISPDATA(1)=$$LJ^XLFSTR($P(RPTDATA,U),"30T")_$E(SPACES,1,1)_$$RJ^XLFSTR($P(RPTDATA,U,2),5)
. S DISPDATA(1)=DISPDATA(1)_$E(SPACES,1,4)_$$LJ^XLFSTR(ADDRESS,"68T")
. I $P(RPTDATA,U,3)'=""!$P(RPTDATA,U,4) D
. . S DISPDATA(1)=DISPDATA(1)_$E(SPACES,1,1)_$$RJ^XLFSTR($P(RPTDATA,U,3),5)_"/"_$$LJ^XLFSTR($P(RPTDATA,U,4),5)
. ; Line 2 - Payer Name(31),VA ID,eIV Natl Enabled,IIU Natl Enabled,eIV Loc Enabled,EligProf/Inst EDI#
. S DISPDATA(2)=$E(SPACES,1,2)_$$LJ^XLFSTR($P(RPTDATA,U,9),"31T")_$E(SPACES,1,11)_$$LJ^XLFSTR($P(RPTDATA,U,10),10)
. S DISPDATA(2)=DISPDATA(2)_$E(SPACES,1,1)_$$LJ^XLFSTR($P(RPTDATA,U,11),3)_$E(SPACES,1,17)_$$LJ^XLFSTR($P(RPTDATA,U,12),3)
. S DISPDATA(2)=DISPDATA(2)_$E(SPACES,1,16)_$$LJ^XLFSTR($P(RPTDATA,U,13),3)
. I $P(RPTDATA,U,14)'=""!$P(RPTDATA,U,15) D
. . S DISPDATA(2)=DISPDATA(2)_$E(SPACES,1,12)_$$RJ^XLFSTR($P(RPTDATA,U,14),5)_"/"_$$RJ^XLFSTR($P(RPTDATA,U,15),5)
. ; line 3 - blank
. S DISPDATA(3)=" "
;
Q
;
LINE(DISPDATA) ; Print data
N LNCT,LNTOT,NWPG
S LNTOT=+$O(DISPDATA(""),-1)
S NWPG=0
F LNCT=1:1:LNTOT D I $G(ZTSTOP)!PXT W ! Q
. I IBOUT="R" D Q:$G(ZTSTOP)!PXT
. . I $Y+1>MAX!('PGC) D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q
. W ! W:IBOUT="R" ?1 W DISPDATA(LNCT) Q
. I 'NWPG!(NWPG&(DISPDATA(LNCT)'="")) W !,?1,DISPDATA(LNCT)
. I NWPG S NWPG=0
. Q
Q
;
N DIR,DTOUT,DUOUT,HDR,LIN,OFFSET,X,Y
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
S PGC=PGC+1
W @IOF,!,"Insurance Company Link Report"
S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
S OFFSET=$S(IBTYP=2:131,1:79)-$L(HDR)
W ?OFFSET,HDR
W !
; IB*752/TAZ - Modified for Select Ins Co.
S HDR=$S(IBTYP=1:"Unlinked Insurance Companies",1:"Linked Insurance Companies")
S HDR=HDR_" - "_$S(($D(IBMAT)>10):"Selected",IBMAT="":"ALL",1:"that contain: "_IBMAT)
S OFFSET=$S(IBTYP=2:131,1:79)-$L(HDR)/2
W ?OFFSET,HDR
W !
I IBTYP=1 D
. W !?32,"# Active",?56,"Prof.",?74,"Inst."
. ;IB*2*687/DTG remove ':' after the Insurance Company in header
. W !,"Insurance Company",?33,"Groups",?56,"EDI#",?74,"EDI#"
. W !,$E(DASH,1,80)
;
I IBTYP=2 D
. ;IB*2*687/DTG remove ':' from the Insurance Company in header
. ;W !,"Insurance Company:",?32,"# Active",?56,"eIV Nationally",?75,"IIU Nationally"
. W !,"Insurance Company",?32,"# Active",?56,"eIV Nationally",?75,"IIU Nationally"
. W ?94,"eIV Locally",?110,"Prof/Inst EDI#"
. ;IB*2*687/DTG remove ':' after the Payer Name in header
. W !," Payer Name",?32,"Groups",?45,"VA ID",?56,"Enabled",?76,"Enabled",?95,"Enabled"
. W !,DASH
Q
;
EHDR ; - Excel format Header
N HDR,X
S X="Insurance Company Link Report^"_$$FMTE^XLFDT($$NOW^XLFDT,1)
W X,!
S HDR=$S(IBTYP=1:"Unlinked Insurance Companies",1:"Linked Insurance Companies")
; IB*752/TAZ - Modified for Select Ins Co.
S HDR=HDR_" - "_$S(($D(IBMAT)>10):"Selected",IBMAT="":"ALL",1:"that contain: "_IBMAT)
W HDR
S X="Insurance Company^Street Address^City^State^Zip^# Active Groups^Claims Prof EDI#^Claims Inst EDI#"
; Unlinked Report
I IBTYP=1 W !,X Q
; Linked Report - add addt'l fields
I IBTYP=2 D
. S X=X_"^Payer Name^VA ID^eIV Nationally Enabled^IIU Nationally Enabled^eIV Locally Enabled^"
. S X=X_"Eligibility Prof EDI#^Eligibility Inst EDI#"
. W !,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPD 18130 printed Oct 16, 2024@18:15:50 Page 2
IBCNERPD ;DAOU/RO - INSURANCE COMPANY LINK REPORT ;AUG-2003
+1 ;;2.0;INTEGRATED BILLING;**184,252,416,521,528,595,602,687,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 ; IB*2.0*687 - split this report out from another report(rewriting it). We reused
+7 ; this routine that the old report no longer needs. Therefore, any changes based
+8 ; on the patches prior to IB*2.0*687 will no longer apply to this code. You will
+9 ; not find any references to them below.
+10 ;
+11 ; Input parameters: N/A
+12 ; Other relevant variables ZTSAVED for queueing:
+13 ; IBCNERTN="IBCNERPD" (current routine name for queueing the COMPILE process)
+14 ; IBCNESPD("ITYPE")=Ins Company type (1-Unlinked Insurance Companies, 2-Linked Insurance Companies)
+15 ; IBCNESPD("IMAT")=Partial matching Ins carriers
+16 ; IBCNESPD("IBOUT")=Output Format ('E'- Excel, 'R' - Report)
+17 ; IBCNESPD("ISORT")=Primary Sort (1-Insurance Company Name, 2-Payer Name, 3-VA National Payer ID)
+18 ;
+19 QUIT
+20 ;
EN ; Main entry pt
+1 ; Init vars
+2 NEW IBCNERTN
+3 SET IBCNERTN="IBCNERPD"
+4 ;
+5 WRITE @IOF
+6 ;IB*2*687/DTG - Add IIU to the report message display
+7 WRITE !,"Insurance Company Link Report",!
+8 WRITE !,"In order for an Insurance Company to be eligible for electronic insurance"
+9 WRITE !,"eligibility communications via the eIV software or to transmit active"
+10 WRITE !,"insurance to another VAMC via IIU, the Insurance Company needs to be"
+11 WRITE !,"linked to an appropriate payer from the National EDI Payer list."
+12 WRITE !,"The National EDI Payer list contains the names of the payers that are"
+13 WRITE !,"currently participating with the eIV and/or IIU process."
+14 WRITE !!,"This report option provides information to assist with finding unlinked"
+15 WRITE !,"insurance companies or payers, which can subsequently be linked through the"
+16 WRITE !,"INSURANCE COMPANY EDIT option."
+17 ;
R10 ; Prompt to select linked vs unlinked insurance companies report option
+1 NEW IBCNESPD,DEST,IBOUT,POP,STOP,ZTQUEUED,ZTREQ,ZTSTOP
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET STOP=0
+4 ;
+5 SET DIR(0)="S^1:Unlinked insurance companies;2:Linked insurance companies"
+6 SET DIR("A")="Select type of companies to display"
+7 SET DIR("?",1)=" 1 - Only insurance companies that are not currently linked to a payer"
+8 SET DIR("?")=" 2 - Only insurance companies that are currently linked to a payer"
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
SET STOP=1
GOTO EXIT
+11 SET IBCNESPD("ITYPE")=Y
+12 ; If Unlinked report the sort defaults to the primary sort and skip the sort prompt.
IF Y=1
SET IBCNESPD("ISORT")=1
+13 ;
+14 ;IB*752/TAZ - Modified prompt to add Select Ins Co.
R15 ;Prompt for All, Keyword search or Select Ins Co.
+1 ;
+2 NEW DIR,X,Y,DIRUT
+3 WRITE !
+4 SET DIR(0)="S^1:ALL insurance companies;2:Keyword search in insurance companies;3:Select insurance companies"
+5 SET DIR("A")="Select companies to display"
+6 SET DIR("?",1)=" Enter 1 - Select ALL insurance companies"
+7 SET DIR("?",2)=" Enter 2 - Text entered into the search keyword field will"
+8 SET DIR("?",3)=" result in the report selecting all insurance"
+9 SET DIR("?",4)=" companies that contain the entered text in the"
+10 SET DIR("?",5)=" insurance company name."
+11 SET DIR("?",6)=" Enter 3 - Individually select insurance companies"
+12 SET DIR("?")=" (multiple companies allowed)"
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DUOUT)!$DATA(DTOUT)
SET Y=""
SET STOP=1
if $$STOP^IBCNERP1
GOTO EXIT
GOTO R10
+15 IF Y=1
SET IBCNESPD("IMAT")=""
GOTO R30
+16 IF Y=2
GOTO R20
+17 GOTO R25
+18 ;
+19 ; IB*752/TAZ - Modified for Select Ins Co.
R20 ; Prompt for Insurance Company Search
+1 NEW DIR,X,Y,DIRUT
+2 ;
+3 WRITE !!,"Text entered into the search keyword field will result in"
+4 WRITE !,"the report selecting all insurance companies that contain"
+5 WRITE !,"the entered text in the insurance company name."
+6 WRITE !
+7 SET DIR(0)="F"
+8 SET DIR("A")="Enter an insurance company search keyword"
+9 SET DIR("?",1)=" Enter a keyword to search insurance company names that"
+10 SET DIR("?",2)=" contain the keyword. Examples of keyword: ('CIGNA' would"
+11 SET DIR("?",3)=" return CIGNA, CIGNA HICN, NATIONAL CIGNA, REGION 1 CIGNA"
+12 SET DIR("?")=" and any others with the term 'CIGNA' in it)"
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DUOUT)!$DATA(DTOUT)
SET Y=""
SET STOP=1
if $$STOP^IBCNERP1
GOTO EXIT
GOTO R15
+15 SET IBCNESPD("IMAT")=Y
+16 GOTO R30
+17 ;
+18 ; IB*752/TAZ - Modified for Select Ins Co.
R25 ;Initialize Prompt for insurance companies.
+1 NEW ARRAY
+2 ;
R26 ; Prompt for multiple insurance companies
+1 ;
+2 DO INSOCAS^IBCNINSC(.ARRAY)
+3 ;
+4 IF $GET(ARRAY)="^"
SET STOP=1
if $$STOP^IBCNERP1
GOTO EXIT
GOTO R15
+5 IF '$GET(ARRAY)
WRITE !,"This is a required response. Enter '^' to exit"
GOTO R26
+6 ;
+7 SET ARRAY=""
+8 MERGE IBCNESPD("IMAT")=ARRAY
+9 ;
R30 ; Prompt to allow users to select output format
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET IBCNESPD("ISORT")=$SELECT(IBCNESPD("ITYPE")=1:1,1:"")
+4 SET DIR(0)="SA^E:Excel;R:Report"
+5 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+6 SET DIR("B")="Report"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET STOP=1
+9 IF STOP
SET IBCNESPD("ISORT")=""
if $$STOP^IBCNERP1
GOTO EXIT
GOTO R15
+10 SET (IBOUT,IBCNESPD("IBOUT"))=Y
+11 ;
+12 ; If the report is in EXCEL format, set the sort to the primary sort and skip the Sort Prompt.
+13 IF IBCNESPD("IBOUT")="E"
SET IBCNESPD("ISORT")=1
+14 ; If Unlinked Report or EXCEL format, this skips over SORT prompt.
+15 IF IBCNESPD("ITYPE")=1!$GET(IBCNESPD("ISORT"))=1
GOTO R50
+16 ;
R40 ; Prompt to allow users to select primary sort
+1 NEW DIR,X,Y,DIRUT
+2 ;
+3 SET DIR(0)="S^1:Insurance Company Name;2:Payer Name;3:VA National Payer ID"
+4 SET DIR("A")="Select the primary sort field"
+5 SET DIR("B")=1
+6 SET DIR("?")=" Select the data field by which this report should be primarily sorted."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET STOP=1
if $$STOP^IBCNERP1
GOTO EXIT
GOTO R30
+9 SET IBCNESPD("ISORT")=Y
+10 ;
R50 ; Proceed to compilation of the data and then generate the output of the report.
+1 IF '$DATA(ZTQUEUED)
IF IBOUT="R"
Begin DoDot:1
+2 WRITE !
IF IBCNESPD("ITYPE")=2
WRITE !,"*** This report is 132 characters wide ***",!
End DoDot:1
+3 IF IBOUT="E"
WRITE !!!,"*** To avoid wrapping, enter '0;256;999' at the 'DEVICE' prompt. ***",!
+4 DO DEVICE(IBCNERTN,.IBCNESPD)
+5 ;IB*752/TAZ - When ^ entered, don't return to prompts.
+6 ;I STOP D G @DEST
+7 ;. I $$STOP^IBCNERP1 S DEST="EXIT" Q
+8 ;. I IBCNESPD("ITYPE")=1 S DEST="R30" Q
+9 ;. I IBCNESPD("IBOUT")="E" S DEST="R30" Q
+10 ;. S DEST="R40"
+11 ;
EXIT ; Exit pt
+1 QUIT
+2 ;
DEVICE(IBCNERTN,IBCNESPD) ; Device Handler and possible TaskManager calls
+1 ; Input params:
+2 ; IBCNERTN = Routine name for ^TMP($J,...
+3 ; IBCNESPD = Array passed by ref of the report params
+4 ; IBOUT = "R" for Report format or "E" for Excel format
+5 ;
+6 NEW POP,ZTDESC,ZTRTN,ZTSAVE
+7 ;
+8 SET ZTRTN="COMPILE^IBCNERPD("""_IBCNERTN_""",.IBCNESPD)"
+9 SET ZTDESC="IBCNE Insurance Company Link Report"
+10 SET ZTSAVE("IBCNESPD(")=""
+11 SET ZTSAVE("IBCNERTN")=""
+12 SET ZTSAVE("IBOUT")=""
+13 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
+14 ;IB*752/TAZ - STOP Variable no longer required since not moving to previous prompts.
+15 ;I POP S STOP=1
+16 QUIT
+17 ;
COMPILE(IBCNERTN,IBCNESPD) ;
+1 ; Entry point called from EN^XUTMDEVQ in either direct or queued mode.
+2 ; Input params:
+3 ; IBCNERTN = Routine name for ^TMP($J,...
+4 ; IBCNESPD = Array passed by ref of the report params
+5 ;
+6 ; Init scratch globals
+7 KILL ^TMP($JOB,IBCNERTN)
+8 ; Compile Data
+9 DO COMPDATA(IBCNERTN,.IBCNESPD)
+10 ; Print Data
+11 IF '$GET(ZTSTOP)
DO OUTPUT(IBCNERTN,.IBCNESPD)
+12 ; Close device
+13 DO ^%ZISC
+14 ; Kill scratch globals
+15 KILL ^TMP($JOB,IBCNERTN)
+16 ; Purge task record
+17 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+18 QUIT
+19 ;
COMPDATA(IBCNERTN,IBCNESPD) ; Compile data
+1 NEW IBI,IBGRP,IBMAT,IBINAME,IBINS,IBPY,IBPYR,IBSORT,IBTYP
+2 NEW IBELOACT,IBENAACT,IBIADDR,IBICITY,IBIINST,IBINAACT,IBIPROF,IBISTATE,IBIZIP
+3 NEW APPEIV,APPIENS,APPIIU,IBPINST,IBPPROF,IBPVAID,IBPYARY,IBRPT,SORT1,SORT2,SORT3
+4 ;
+5 IF '$DATA(ZTQUEUED)
IF $GET(IOST)["C-"
IF IBOUT="R"
WRITE !!,"Compiling report data ..."
+6 ;
+7 ; Kill scratch globals
+8 KILL ^TMP($JOB,IBCNERTN)
+9 ;
+10 SET IBTYP=$GET(IBCNESPD("ITYPE"))
+11 SET IBSORT=$GET(IBCNESPD("ISORT"))
+12 ; IB*752/TAZ - Modified for Select Ins Co.
+13 MERGE IBMAT=IBCNESPD("IMAT")
+14 SET (SORT1,SORT2,SORT3)=""
+15 ;
+16 ; Loop thru the Insurance company file
+17 SET IBINS=0
+18 FOR
SET IBINS=$ORDER(^DIC(36,IBINS))
if 'IBINS
QUIT
Begin DoDot:1
+19 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+20 SET IBINAME=$$GET1^DIQ(36,IBINS,.01,"I")
+21 IF IBINAME=""
QUIT
+22 ; ICR #10104
IF IBMAT'=""
IF '$FIND($$UP^XLFSTR(IBINAME),$$UP^XLFSTR(IBMAT))
QUIT
+23 ; IB*752/TAZ - Modified for Select Ins Co.
+24 ;IB*743/TAZ - Not a selected insurance co.
IF $DATA(IBMAT)>10
IF '$DATA(IBMAT(IBINS))
QUIT
+25 ; Get active group count
+26 SET (IBI,IBGRP)=0
FOR
SET IBI=$ORDER(^IBA(355.3,"B",IBINS,IBI))
if 'IBI
QUIT
IF '$$GET1^DIQ(355.3,IBI,.11,"I")
SET IBGRP=IBGRP+1
+27 ;
+28 SET (IBENAACT,IBELOACT,IBINAACT,IBPPROF,IBPINST,IBPYR,IBPVAID)=""
+29 ; Get PROF ID, INST ID and address from Insurance file
+30 ;Ins co PROF ID
SET IBIPROF=$$GET1^DIQ(36,IBINS,3.02,"I")
+31 ;Ins co INST ID
SET IBIINST=$$GET1^DIQ(36,IBINS,3.04,"I")
+32 SET IBIADDR=$$GET1^DIQ(36,IBINS,.111,"I")
SET IBIADDR=$EXTRACT(IBIADDR,1,35)
+33 SET IBICITY=$$GET1^DIQ(36,IBINS,.114,"I")
SET IBICITY=$EXTRACT(IBICITY,1,25)
+34 SET IBISTATE=$$GET1^DIQ(5,+$$GET1^DIQ(36,IBINS,.115,"I"),1)
+35 SET IBIZIP=$$GET1^DIQ(36,IBINS,.116,"I")
+36 ; Get payer
+37 SET IBPY=$$GET1^DIQ(36,IBINS,3.10,"I")
+38 ; If Unlinked Report and there is a Payer, quit.
+39 IF IBTYP=1
IF IBPY'=""
QUIT
+40 ; If Linked Report and there isn't a Payer, quit.
+41 IF IBTYP=2
IF IBPY=""
QUIT
+42 ; Linked Report, get data from the Payer File (#365.12)
+43 IF IBTYP=2
Begin DoDot:2
+44 ;Payer Name
SET IBPYR=$$GET1^DIQ(365.12,IBPY,.01,"I")
+45 ;VA National ID
SET IBPVAID=$$GET1^DIQ(365.12,IBPY,.02,"I")
+46 ;PROF ID (eligibility)
SET IBPPROF=$$GET1^DIQ(365.12,IBPY,.05,"I")
+47 ;INST ID
SET IBPINST=$$GET1^DIQ(365.12,IBPY,.06,"I")
+48 ; Get application info
+49 KILL IBPYARY
+50 DO PAYER^IBCNINSU(IBPY,,"**","I",.IBPYARY)
+51 ; Payer EIV app
+52 SET APPEIV=$$PYRAPP^IBCNEUT5("EIV",IBPY)
+53 IF APPEIV'=""
Begin DoDot:3
+54 SET APPIENS=""_APPEIV_","_IBPY_","_""
+55 SET IBENAACT=IBPYARY(365.121,APPIENS,.02,"I")
+56 SET IBENAACT=$SELECT(IBENAACT=1:"YES",1:"NO")
+57 SET IBELOACT=IBPYARY(365.121,APPIENS,.03,"I")
+58 SET IBELOACT=$SELECT(IBELOACT=1:"YES",1:"NO")
End DoDot:3
+59 ; Payer IIU app
+60 SET APPIIU=$$PYRAPP^IBCNEUT5("IIU",IBPY)
+61 IF APPIIU'=""
Begin DoDot:3
+62 SET APPIENS=""_APPIIU_","_IBPY_","_""
+63 SET IBINAACT=IBPYARY(365.121,APPIENS,.02,"I")
+64 SET IBINAACT=$SELECT(IBINAACT=1:"YES",1:"NO")
End DoDot:3
+65 ; Linked Report - SORT fields based upon the SORT that was chosen
+66 ; IBSORT=1 equals the Primary Sort sequence: IBINAME,IBPYR,IBPVAID
+67 ; IBSORT=2 equals the Payer Sort sequence: IBPYR,IBINAME,IBPVAID
+68 ; IBSORT=3 equals the VA ID Sort sequence: IBPVAID,IBINAME,IBPYR
+69 IF IBSORT=1
SET SORT1=IBINAME
SET SORT2=IBPYR
SET SORT3=IBPVAID
+70 IF IBSORT=2
SET SORT1=IBPYR
SET SORT2=IBINAME
SET SORT3=IBPVAID
+71 IF IBSORT=3
SET SORT1=IBPVAID
SET SORT2=IBINAME
SET SORT3=IBPYR
+72 IF SORT1=""
SET SORT1=" "
End DoDot:2
+73 IF IBOUT="E"
SET SORT1=IBINAME
SET SORT2=IBPYR
SET SORT3=IBPVAID
+74 ;
+75 ; The Unlinked Report doesn't contain Payer info
+76 IF IBTYP=1
SET (SORT1,SORT2,SORT3)=$SELECT(IBINAME'="":IBINAME,1:" ")
+77 ;
+78 ; The Unlinked report only uses (IBGRP-IBIZIP). The REPORT format uses all fields
+79 SET IBRPT=IBINAME_U_IBGRP_U_IBIPROF_U_IBIINST_U_IBIADDR_U_IBICITY_U_IBISTATE_U_IBIZIP
+80 SET IBRPT=IBRPT_U_IBPYR_U_IBPVAID_U_IBENAACT_U_IBINAACT_U_IBELOACT_U_IBPPROF_U_IBPINST
+81 SET ^TMP($JOB,IBCNERTN,SORT1,SORT2,SORT3,IBINS)=IBRPT
End DoDot:1
if $GET(ZTSTOP)
QUIT
+82 QUIT
+83 ;
OUTPUT(IBCNERTN,IBCNESPD) ; Sets IO params for printing
+1 NEW IBMAT,IBPGC,IBPXT,IBSORT,IBTYP
+2 NEW CRT,DIR,DTOUT,DUOUT,LIN,MAXCNT,X,Y,ZZ
+3 ;
+4 SET IBTYP=$GET(IBCNESPD("ITYPE"))
+5 SET IBSORT=$GET(IBCNESPD("ISORT"))
+6 ; IB*752/TAZ - Modified for Select Ins Co.
+7 MERGE IBMAT=IBCNESPD("IMAT")
+8 ;
+9 ;S (IBPXT,IBPGC)=0
SET (CRT,IBPGC,IBPXT,MAXCNT)=0
+10 ;
+11 ; Determine IO params
+12 IF "^R^E^"'[(U_$GET(IBOUT)_U)
SET IBOUT="R"
+13 IF IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+14 IF '$TEST
SET MAXCNT=IOSL-6
SET CRT=0
+15 DO PRINT(IBCNERTN,IBTYP,IBSORT,.IBPGC,.IBPXT,MAXCNT,CRT,IBOUT)
+16 IF $GET(ZTSTOP)!IBPXT
GOTO OUTPUTX
+17 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+18 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+19 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+20 ; End of Excel Report
IF IBOUT="E"
IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
KILL DIR
OUTPUTX ; Exit pt
+1 QUIT
+2 ;
PRINT(RTN,IBTYP,SRT,PGC,PXT,MAX,CRT,IBOUT) ; Print data
+1 ; Input: RTN="IBCENRPB", PGC=page ct,
+2 ; PXT=exit flg, MAX=max line ct/pg,
+3 ; CRT=1/0, IBOUT="R"/"E"
+4 NEW CNT,DASH,EORMSG,NONEMSG,SORT1,SORT2,SORT3,SPACES
+5 SET EORMSG="*** END OF REPORT ***"
+6 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+7 SET $PIECE(DASH,"-",133)=""
SET $PIECE(SPACES," ",132)=""
+8 ;
+9 ;Excel header
+10 IF IBOUT="E"
DO EHDR
+11 ;
+12 ; If No Data
+13 IF '$DATA(^TMP($JOB,RTN))
if (IBOUT="R")
DO HEADER
WRITE !,?(80-$LENGTH(NONEMSG)\2),NONEMSG,!!
+14 ;
+15 SET SORT1=""
FOR
SET SORT1=$ORDER(^TMP($JOB,RTN,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+16 SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,RTN,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+17 SET SORT3=""
FOR
SET SORT3=$ORDER(^TMP($JOB,RTN,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:3
+18 SET CNT=""
FOR
SET CNT=$ORDER(^TMP($JOB,RTN,SORT1,SORT2,SORT3,CNT))
if CNT=""
QUIT
Begin DoDot:4
+19 ; Init disp
KILL DISPDATA
+20 DO DATA(.DISPDATA)
DO LINE(.DISPDATA)
End DoDot:4
if PXT!$GET(ZTSTOP)
QUIT
End DoDot:3
if PXT!$GET(ZTSTOP)
QUIT
End DoDot:2
if PXT!$GET(ZTSTOP)
QUIT
End DoDot:1
if PXT!$GET(ZTSTOP)
QUIT
+21 ;
+22 IF $GET(ZTSTOP)!PXT
GOTO PRINTEX
+23 IF IBOUT="R"
Begin DoDot:1
+24 IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!PXT
GOTO PRINTEX
End DoDot:1
+25 WRITE !,?(80-$LENGTH(EORMSG)\2),EORMSG
PRINTEX ;
+1 QUIT
+2 ;
DATA(DISPDATA) ; Build display lines
+1 NEW ADDRESS,I,LCT,RPTDATA,ZIPCODE
+2 ; Merge into local variable
+3 MERGE RPTDATA=^TMP($JOB,RTN,SORT1,SORT2,SORT3,CNT)
+4 ;
+5 ; Format Zip Codes, add a "-" after the first 5 digits and before the last 4 digits (99999-9999)
+6 SET ZIPCODE=$EXTRACT($PIECE(RPTDATA,U,8),1,5)
+7 IF $LENGTH($PIECE(RPTDATA,U,8))>5
SET ZIPCODE=$EXTRACT($PIECE(RPTDATA,U,8),1,5)_"-"_$EXTRACT($PIECE(RPTDATA,U,8),6,9)
+8 ;
+9 ; Excel format for Unlinked and Linked Reports
+10 IF IBOUT="E"
Begin DoDot:1
+11 SET LCT=1
SET DISPDATA(1)=$PIECE(RPTDATA,U)_U_$PIECE(RPTDATA,U,5)_U_$PIECE(RPTDATA,U,6)
+12 SET DISPDATA(1)=DISPDATA(1)_U_$PIECE(RPTDATA,U,7)_U_ZIPCODE
+13 SET DISPDATA(1)=DISPDATA(1)_U_$PIECE(RPTDATA,U,2)_U_$PIECE(RPTDATA,U,3)_U_$PIECE(RPTDATA,U,4)
+14 IF IBTYP=2
Begin DoDot:2
+15 FOR I=9:1:$LENGTH(RPTDATA,U)
SET DISPDATA(1)=DISPDATA(1)_U_$PIECE(RPTDATA,U,I)
End DoDot:2
End DoDot:1
QUIT
+16 ;
+17 ; Report format (Address(35), City(25), State(2) Zip Code
+18 SET ADDRESS=$EXTRACT($PIECE(RPTDATA,U,5),1,35)_" "_$EXTRACT($PIECE(RPTDATA,U,6),1,25)_", "_$$LJ^XLFSTR($PIECE(RPTDATA,U,7),"2T")_$EXTRACT(SPACES,1,1)_$$LJ^XLFSTR(ZIPCODE,"10T")
+19 ;
+20 ; Unlinked Report
+21 IF IBTYP=1
Begin DoDot:1
+22 ; Line 1 - Ins co, # Active Groups, Claim Prof EDI#, Claim Inst EDI#
+23 SET DISPDATA(1)=$$LJ^XLFSTR($PIECE(RPTDATA,U),"30T")_$EXTRACT(SPACES,1,2)_$$RJ^XLFSTR($PIECE(RPTDATA,U,2),5)
+24 SET DISPDATA(1)=DISPDATA(1)_$EXTRACT(SPACES,1,18)_$$RJ^XLFSTR($PIECE(RPTDATA,U,3),5)
+25 SET DISPDATA(1)=DISPDATA(1)_$EXTRACT(SPACES,1,12)_$$RJ^XLFSTR($PIECE(RPTDATA,U,4),5)
+26 ; line 2 - Ins co Address
+27 SET DISPDATA(2)=$EXTRACT(SPACES,1,9)_ADDRESS
+28 ; line 3 - blank
+29 SET DISPDATA(3)=" "
End DoDot:1
+30 ; Linked Report
+31 IF IBTYP=2
Begin DoDot:1
+32 ; Line 1 - Ins Co(30),# Active Grps, Address line 1, City, ST, Zip, Prof/Inst EDI#
+33 SET DISPDATA(1)=$$LJ^XLFSTR($PIECE(RPTDATA,U),"30T")_$EXTRACT(SPACES,1,1)_$$RJ^XLFSTR($PIECE(RPTDATA,U,2),5)
+34 SET DISPDATA(1)=DISPDATA(1)_$EXTRACT(SPACES,1,4)_$$LJ^XLFSTR(ADDRESS,"68T")
+35 IF $PIECE(RPTDATA,U,3)'=""!$PIECE(RPTDATA,U,4)
Begin DoDot:2
+36 SET DISPDATA(1)=DISPDATA(1)_$EXTRACT(SPACES,1,1)_$$RJ^XLFSTR($PIECE(RPTDATA,U,3),5)_"/"_$$LJ^XLFSTR($PIECE(RPTDATA,U,4),5)
End DoDot:2
+37 ; Line 2 - Payer Name(31),VA ID,eIV Natl Enabled,IIU Natl Enabled,eIV Loc Enabled,EligProf/Inst EDI#
+38 SET DISPDATA(2)=$EXTRACT(SPACES,1,2)_$$LJ^XLFSTR($PIECE(RPTDATA,U,9),"31T")_$EXTRACT(SPACES,1,11)_$$LJ^XLFSTR($PIECE(RPTDATA,U,10),10)
+39 SET DISPDATA(2)=DISPDATA(2)_$EXTRACT(SPACES,1,1)_$$LJ^XLFSTR($PIECE(RPTDATA,U,11),3)_$EXTRACT(SPACES,1,17)_$$LJ^XLFSTR($PIECE(RPTDATA,U,12),3)
+40 SET DISPDATA(2)=DISPDATA(2)_$EXTRACT(SPACES,1,16)_$$LJ^XLFSTR($PIECE(RPTDATA,U,13),3)
+41 IF $PIECE(RPTDATA,U,14)'=""!$PIECE(RPTDATA,U,15)
Begin DoDot:2
+42 SET DISPDATA(2)=DISPDATA(2)_$EXTRACT(SPACES,1,12)_$$RJ^XLFSTR($PIECE(RPTDATA,U,14),5)_"/"_$$RJ^XLFSTR($PIECE(RPTDATA,U,15),5)
End DoDot:2
+43 ; line 3 - blank
+44 SET DISPDATA(3)=" "
End DoDot:1
+45 ;
+46 QUIT
+47 ;
LINE(DISPDATA) ; Print data
+1 NEW LNCT,LNTOT,NWPG
+2 SET LNTOT=+$ORDER(DISPDATA(""),-1)
+3 SET NWPG=0
+4 FOR LNCT=1:1:LNTOT
Begin DoDot:1
+5 IF IBOUT="R"
Begin DoDot:2
+6 IF $Y+1>MAX!('PGC)
DO HEADER
SET NWPG=1
IF $GET(ZTSTOP)!PXT
QUIT
End DoDot:2
if $GET(ZTSTOP)!PXT
QUIT
+7 WRITE !
if IBOUT="R"
WRITE ?1
WRITE DISPDATA(LNCT)
QUIT
+8 IF 'NWPG!(NWPG&(DISPDATA(LNCT)'=""))
WRITE !,?1,DISPDATA(LNCT)
+9 IF NWPG
SET NWPG=0
+10 QUIT
End DoDot:1
IF $GET(ZTSTOP)!PXT
WRITE !
QUIT
+11 QUIT
+12 ;
+1 NEW DIR,DTOUT,DUOUT,HDR,LIN,OFFSET,X,Y
+2 IF CRT
IF PGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 IF MAX<51
FOR LIN=1:1:(MAX-$Y)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET PXT=1
QUIT
End DoDot:1
IF PXT
GOTO HEADERX
+6 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET ZTSTOP=1
GOTO HEADERX
+7 SET PGC=PGC+1
+8 WRITE @IOF,!,"Insurance Company Link Report"
+9 SET HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
+10 SET OFFSET=$SELECT(IBTYP=2:131,1:79)-$LENGTH(HDR)
+11 WRITE ?OFFSET,HDR
+12 WRITE !
+13 ; IB*752/TAZ - Modified for Select Ins Co.
+14 SET HDR=$SELECT(IBTYP=1:"Unlinked Insurance Companies",1:"Linked Insurance Companies")
+15 SET HDR=HDR_" - "_$SELECT(($DATA(IBMAT)>10):"Selected",IBMAT="":"ALL",1:"that contain: "_IBMAT)
+16 SET OFFSET=$SELECT(IBTYP=2:131,1:79)-$LENGTH(HDR)/2
+17 WRITE ?OFFSET,HDR
+18 WRITE !
+19 IF IBTYP=1
Begin DoDot:1
+20 WRITE !?32,"# Active",?56,"Prof.",?74,"Inst."
+21 ;IB*2*687/DTG remove ':' after the Insurance Company in header
+22 WRITE !,"Insurance Company",?33,"Groups",?56,"EDI#",?74,"EDI#"
+23 WRITE !,$EXTRACT(DASH,1,80)
End DoDot:1
+24 ;
+25 IF IBTYP=2
Begin DoDot:1
+26 ;IB*2*687/DTG remove ':' from the Insurance Company in header
+27 ;W !,"Insurance Company:",?32,"# Active",?56,"eIV Nationally",?75,"IIU Nationally"
+28 WRITE !,"Insurance Company",?32,"# Active",?56,"eIV Nationally",?75,"IIU Nationally"
+29 WRITE ?94,"eIV Locally",?110,"Prof/Inst EDI#"
+30 ;IB*2*687/DTG remove ':' after the Payer Name in header
+31 WRITE !," Payer Name",?32,"Groups",?45,"VA ID",?56,"Enabled",?76,"Enabled",?95,"Enabled"
+32 WRITE !,DASH
End DoDot:1
+1 QUIT
+2 ;
EHDR ; - Excel format Header
+1 NEW HDR,X
+2 SET X="Insurance Company Link Report^"_$$FMTE^XLFDT($$NOW^XLFDT,1)
+3 WRITE X,!
+4 SET HDR=$SELECT(IBTYP=1:"Unlinked Insurance Companies",1:"Linked Insurance Companies")
+5 ; IB*752/TAZ - Modified for Select Ins Co.
+6 SET HDR=HDR_" - "_$SELECT(($DATA(IBMAT)>10):"Selected",IBMAT="":"ALL",1:"that contain: "_IBMAT)
+7 WRITE HDR
+8 SET X="Insurance Company^Street Address^City^State^Zip^# Active Groups^Claims Prof EDI#^Claims Inst EDI#"
+9 ; Unlinked Report
+10 IF IBTYP=1
WRITE !,X
QUIT
+11 ; Linked Report - add addt'l fields
+12 IF IBTYP=2
Begin DoDot:1
+13 SET X=X_"^Payer Name^VA ID^eIV Nationally Enabled^IIU Nationally Enabled^eIV Locally Enabled^"
+14 SET X=X_"Eligibility Prof EDI#^Eligibility Inst EDI#"
+15 WRITE !,X
End DoDot:1
+16 QUIT
