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

IBCNERPC ;DAOU/RO - IIV PAYER LINK REPORT COMPILE ;AUG-2003

 ;;2.0;INTEGRATED BILLING;**184,252,271**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ; IIV - Insurance Identification and Verification

 ;

 ; Input vars from IBCNERPB:

 ;  IBCNESPC("REP")=1 for Payer List report, 2 for Company List

 ;  IBCNESPC("PTYPE")=Payer type (1-no active ins linked, 2-at least 1 ins linked, 3-All Payers)

 ;  IBCNESPC("PSORT")=Primary Sort for Payer report

 ;  IBCNESPC("PDET")=Ins detail on payer report (1-include list of ins,2-do not list)

 ;

 ;  IBCNESPC("ITYPE")=Ins Company type (1-no payer link, 2-linked to payer, 3-All ins companies)

 ;  IBCNESPC("ISORT")=Primary Sort for Payer Insurance report

 ;  IBCNESPC("IMAT")=Partial matching Ins carriers

 ;

 ; Output vars used by IBCNERPC:

 ;  

 ;   IBCNERTN="IBCNERPB"

 ;   SORT1=depends on sorting option chosen

 ;   SORT2=Payer Name (Report by Payer) or Ins Company Name (if report is Insurance)

 ;  ^TMP($J,IBCNERTN,SORT1,SORT2,CNT) 

 ;   CNT=Seq ct

 ;  ^TMP($J,IBCNERTN,SORT1,SORT2,CNT,1) 

 ;

 ; Must call at EN

 Q

 ;

EN(IBCNERTN,IBCNESPC) ; Entry

 ; Init

 N IBTYP,IBCT,IBCTX

 ;

 N IBDET,IBSRT,IBPY,IBVAID,IBPROF,IBINST,IBNAACT,IBLOACT,IBINS,IBINST

 N IBINSN,IBAPP,IBPYR,SORT1,SORT2,IBSRT,IBMAT,IBPPYR,IBREP

 ;

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

 ;

 ; Temp ct

 S IBCT=0

 ;

 ; Kill scratch globals

 K ^TMP($J,IBCNERTN)

 ;

 ;

 S IBREP=$G(IBCNESPC("REP"))

 S IBDET=$G(IBCNESPC("PDET"))

 S IBTYP=$G(IBCNESPC("PTYPE"))

 S IBSRT=$G(IBCNESPC("PSORT"))

 S IBPPYR=$G(IBCNESPC("PPYR"))

 ;

 ; Ins Report

 I IBREP=2 G INS

 ;

 ; Loop thru the IIV payer File (#365.12)

 S IBPY=0,SORT1=""

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

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

 . ; Payer name from Payer File (#365.12)

 . S IBPYR=$P($G(^IBE(365.12,IBPY,0)),U) I IBSRT=1 S SORT1=IBPYR

 . S SORT2=IBPYR

 . I IBPYR=""!(IBPYR="~NO PAYER")!($$PYRAPP^IBCNEUT5("IIV",IBPY)="") Q

 . I IBPPYR'="",IBPY'=$P(IBPPYR,U) Q

 . ; get VA national ID

 . S IBVAID=$P($G(^IBE(365.12,IBPY,0)),U,2) I IBSRT=2 S SORT1=IBVAID

 . ; get the EDI numbers (professional and institutional)

 . S IBPROF=$P($G(^IBE(365.12,IBPY,0)),U,5)

 . S IBINST=$P($G(^IBE(365.12,IBPY,0)),U,6)

 . S IBAPP=$$PYRAPP^IBCNEUT5("IIV",IBPY),(IBNAACT,IBLOACT)=0

 . S:IBAPP'="" IBNAACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,2)

 . S:IBAPP'="" IBLOACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,3)

 . ; if no sort value, use 0

 . I IBSRT=3 S SORT1=IBNAACT I SORT1="" S SORT1=0

 . I IBSRT=4 S SORT1=IBLOACT I SORT1="" S SORT1=0

 . I SORT1="" S SORT1=" "

 . ; if sorting by count and detail, need to figure count first else sort will not work

 . I IBSRT=5,IBTYP>1,IBDET=1 D  S SORT1=-IBCTX

 . . S IBCTX=0,IBINS="" F  S IBINS=$O(^DIC(36,"AC",IBPY,IBINS)) Q:IBINS=""  D

 . . . S IBINSN=$G(^DIC(36,IBINS,0)),IBINSN=$P(IBINSN,U) Q:IBINSN=""  S IBCTX=IBCTX+1

 . ; search for insurance carriers for this payer

 . S IBCT=0,IBINS="" F  S IBINS=$O(^DIC(36,"AC",IBPY,IBINS)) Q:IBINS=""  D

 . . S IBINSN=$G(^DIC(36,IBINS,0)),IBINSN=$P(IBINSN,U) Q:IBINSN=""

 . . S IBCT=IBCT+1 I IBTYP=1 Q

 . . ; save off address and EDI#'s for Insurance carrier

 . . I IBDET=1 S ^TMP($J,IBCNERTN,SORT1,SORT2,IBPY,IBINSN,IBINS)=$P($G(^DIC(36,IBINS,.11)),U,1,6)_U_$P($G(^DIC(36,IBINS,3)),U,2)_U_$P($G(^DIC(36,IBINS,3)),U,4)

 . I IBTYP=1,IBCT>0 Q

 . I IBTYP=2,IBCT=0 Q

 . ; use reverse sort for count

 . I IBSRT=5 S SORT1=-IBCT

 . S ^TMP($J,IBCNERTN,SORT1,SORT2,IBPY)=IBVAID_U_IBPROF_U_IBINST_U_IBNAACT_U_IBLOACT_U_IBCT

 G EXIT

 ;

INS ;

 S IBTYP=$G(IBCNESPC("ITYPE"))

 S IBSRT=$G(IBCNESPC("ISORT"))

 S IBMAT=$G(IBCNESPC("IMAT"))

 ; 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 (SORT1,IBPYR,IBNAACT,IBLOACT,IBPROF,IBINST,IBVAID)=""

 . S IBINSN=$P($G(^DIC(36,IBINS,0)),U) I IBSRT=1 S SORT1=IBINSN

 . S SORT2=IBINSN

 . I IBINSN="" Q

 . I IBMAT'="",'$F($$UP^XLFSTR(IBINSN),$$UP^XLFSTR(IBMAT)) Q

 . ; get payer

 . S IBPY=$P($G(^DIC(36,IBINS,3)),U,10)

 . I IBTYP=1,IBPY'="" Q

 . I IBTYP=2,IBPY="" Q

 . I IBPY'="" D

 . . ; Payer name from Payer File (#365.12)

 . . S IBPYR=$P($G(^IBE(365.12,IBPY,0)),U) I IBSRT=2 S SORT1=IBPYR

 . . ; get VA national ID

 . . S IBVAID=$P($G(^IBE(365.12,IBPY,0)),U,2) I IBSRT=3 S SORT1=IBVAID

 . . S IBPROF=$P($G(^IBE(365.12,IBPY,0)),U,5)

 . . S IBINST=$P($G(^IBE(365.12,IBPY,0)),U,6)

 . . S IBAPP=$$PYRAPP^IBCNEUT5("IIV",IBPY),(IBNAACT,IBLOACT)=0

 . . S:IBAPP'="" IBNAACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,2)

 . . S:IBAPP'="" IBLOACT=$P($G(^IBE(365.12,IBPY,1,IBAPP,0)),U,3)

 . . I IBSRT=4 S SORT1=IBNAACT I SORT1="" S SORT1=0

 . . I IBSRT=5 S SORT1=IBLOACT I SORT1="" S SORT1=0

 . I SORT1="" S SORT1=" "

 . S ^TMP($J,IBCNERTN,SORT1,SORT2,IBINS)=IBPYR_U_IBVAID_U_IBPROF_U_IBINST_U_IBNAACT_U_IBLOACT_U_IBCT_U_$G(^DIC(36,IBINS,.11))_U_"~"_$G(^DIC(36,IBINS,3))

 ;

EXIT ;

 Q

 ; Lines moved from IBCNERPB

ITYPE ; Prompt to select Insurance Company type to include

 ; Init vars

 N DIR,X,Y,DIRUT

 ;

 S DIR(0)="S^1:Unlinked insurance companies;2:Linked insurance companies;3:All insurance companies"

 S DIR("A")="Select type of insurance companies to display"

 S DIR("B")="3"

 S DIR("?",1)="  1 - Only insurance companies that are not currently linked to a payer"

 S DIR("?",2)="  2 - Only insurance companies that are currently linked to a payer"

 S DIR("?")="  3 - ALL insurance companies"

 D ^DIR K DIR

 I $D(DIRUT) S STOP=1 G ITYPEX

 S IBCNESPC("ITYPE")=Y

 ;

ITYPEX ; TYPE exit pt

 Q

ISORT ; Prompt to allow users to select primary sort

 ; Init vars

 N DIR,X,Y,DIRUT

 ;

 S DIR(0)="S^1:Insurance Company Name;2:Payer Name;3:VA National Payer ID;4:Nationally Enabled Status;5:Locally Enabled Status"

 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 ISORTX

 S IBCNESPC("ISORT")=Y

 ;

ISORTX ; SORT exit pt

 Q

IMAT ; Prompt to allow users to select partial Ins carrier to include

 N DIR,X,Y,DIRUT

 ;

 W !

 S DIR(0)="FO"

 S DIR("A")="Enter an insurance company search keyword (RETURN for ALL)"

 S DIR("B")=""

 S DIR("?",1)="     Enter a value to match insurance company names with."

 S DIR("?",2)="     Simply hit RETURN to select ALL or enter a keyword"

 S DIR("?",3)="     (ex. 'CIGNA' would return CIGNA, CIGNA HICN, NATIONAL CIGNA,"

 S DIR("?")="     REGION 1 CIGNA and any others with the term 'CIGNA' in it)"

 D ^DIR K DIR

 I $D(DUOUT)!$D(DTOUT) S Y="" S STOP=1 G IMATX

 S IBCNESPC("IMAT")=Y

 ;                                                                       

IMATX Q