IBCNSGE ;ALB/ESG - Insurance Company EDI Parameter Report ;07-JAN-2005
;;2.0;INTEGRATED BILLING;**296,400,521,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
; eClaims Plus
; Identify insurance companies and display EDI parameter information.
;
;
EN ; Entry Point
NEW IBRINS,IBRBID,IBRINS1,IBRINS2,IBRSORT,STOP
D SELECT I STOP G EXIT
D SORT I STOP G EXIT
D DEVICE
EXIT ;
Q
;
SELECT ; Select insurance companies to include on the report
NEW DIR,DIC,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBQ
SEL1 ;
S STOP=0,IBQ=0
W @IOF
W !!?21,"Insurance Company EDI Parameter Report"
W !!?5,"This report will display the EDI parameter information for selected"
W !?5,"insurance companies. You can specify one company, multiple companies,"
W !?5,"a range of company names, or all companies on file."
;
S DIR(0)="SO^A:Include All Insurance Companies;S:Select Specific Insurance Companies;R:Specify a Range of Insurance Company Names"
S DIR("A")=" Method for selecting insurance companies"
S DIR("B")="A"
S DIR("?",1)="Enter a code from the list. This defines how you want to select insurance"
S DIR("?",2)="companies for this report."
S DIR("?",3)=""
S DIR("?",4)="If you choose 'A', then all active companies will be included."
S DIR("?",5)="If you choose 'S', then one or more specific companies can be selected."
S DIR("?")="If you choose 'R', then you can enter a range of company names."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SELX
S IBRINS=Y
I '$F(".A.S.R.","."_IBRINS_".") S STOP=1 G SELX
I IBRINS="S" D MULT I IBQ G SEL1 ; choose one or many
I IBRINS="R" D RANGE I IBQ G SEL1 ; choose a range
;
W !
S DIR(0)="YO"
S DIR("A",1)="Only include Insurance Companies with Electronic"
S DIR("A")=" Bill ID's that are blank or contain ""PRNT"""
S DIR("B")="NO"
S DIR("?",1)="Enter either 'Y' or 'N'. If you choose 'Y', then this will limit the selection"
S DIR("?",2)="of insurance companies. Only those companies in which the Inst ID or the Prof"
S DIR("?",3)="ID is either blank or contains ""PRNT"" (uppercase or lowercase)"
S DIR("?")="will be included."
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SELX
S IBRBID=Y
SELX ;
Q
;
MULT ; select one or many insurance companies
NEW DIC,X,Y
K IBRINS S IBRINS="S"
F D Q:Y'>0
. W ! S DIC("A")="Insurance Company: "
. S DIC("S")="I $$ACTIVE^IBCNEUT4(Y)" ; screen out Inactives
. S DIC=36,DIC(0)="AEQM" D ^DIC
. Q:Y'>0
. S IBRINS(+Y)=$P($G(^DIC(36,+Y,0)),U,1)
. Q
I $O(IBRINS(""))="" S IBQ=1 G MULTX ; none selected
MULTX ;
Q
;
RANGE ; select a range of insurance company names
K IBRINS1,IBRINS2
W !
S DIR(0)="FO",DIR("A")="Start with Insurance Company"
S DIR("?",1)="This response can be free text."
S DIR("?",2)="Responses are case sensitive."
S DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna."
S DIR("B")="First" D ^DIR K DIR
I $D(DIRUT) S IBQ=1 G RANGEX
S IBRINS1=Y
I IBRINS1="First" S IBRINS1=" "
;
W !
S DIR(0)="FO",DIR("A")="Go to Insurance Company"
S DIR("?",1)="This response can be free text."
S DIR("?",2)="Responses are case sensitive."
S DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna."
S DIR("B")="Last" D ^DIR K DIR
I $D(DIRUT) S IBQ=1 G RANGEX
S IBRINS2=Y
I IBRINS2="Last" S IBRINS2="~~~~~"
;
I IBRINS1=" ",IBRINS2="~~~~~" D G RANGEX
. K IBRINS,IBRINS1,IBRINS2
. S IBRINS="A"
. Q
;
I IBRINS1]IBRINS2 D G RANGE
. W !!?5,"Sorry ..... Ending name must come after Starting name"
. W !!?5,"Please try again",*7
. Q
;
RANGEX ;
Q
;
SORT ; Choose the sorting method
; MRD;IB*2.0*516 - Removed sort option 6, Use VAMC as Billing Provider.
NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
W !!?5,"*** Sort Criteria ***"
;S DIR(0)="SO^1:Insurance Company Name;2:Prof Electronic Bill ID;3:Inst Electronic Bill ID;4:Electronic Type;5:Type Of Coverage;6:Use VAMC as Billing Provider"
S DIR(0)="SO^1:Insurance Company Name;2:Prof Electronic Bill ID;3:Inst Electronic Bill ID;4:Electronic Type;5:Type Of Coverage"
S DIR("A")="Sort By",DIR("B")=1
D ^DIR K DIR
I $D(DIRUT) S STOP=1 G SORTX
S IBRSORT=Y
SORTX ;
Q
;
COMPILE ; Entry point for task; compile scratch global, print, clean-up
;
NEW RTN,INSIEN,INSNM,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY
NEW STATE,TYPCOV,TRANS,INSTYP,SORT,TMP,IBHPID
;
S RTN="IBCNSGE"
KILL ^TMP($J,RTN) ; init
;
; all insurances
I IBRINS="A" D
. S INSIEN=0
. F S INSIEN=$O(^DIC(36,INSIEN)) Q:'INSIEN D CALC(INSIEN)
. Q
;
; specific insurances
I IBRINS="S" D
. S INSIEN=0
. F S INSIEN=$O(IBRINS(INSIEN)) Q:'INSIEN D CALC(INSIEN)
. Q
;
; a range of insurances
I IBRINS="R" D
. S INSNM=$O(^DIC(36,"B",IBRINS1),-1)
. F S INSNM=$O(^DIC(36,"B",INSNM)) Q:INSNM="" Q:INSNM]IBRINS2 D
.. S INSIEN=0
.. F S INSIEN=$O(^DIC(36,"B",INSNM,INSIEN)) Q:'INSIEN D CALC(INSIEN)
.. Q
. Q
;
D PRINT ; print the report
D ^%ZISC ; close the device
KILL ^TMP($J,RTN) ; kill scratch global
I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
COMPX ;
Q
;
CALC(INS) ; extract insurance data for company ien=INS
;
I '$$ACTIVE^IBCNEUT4(INS) G CALCX ; not active
S DATA=$G(^DIC(36,INS,0))
S ADDR=$G(^DIC(36,INS,.11))
S EDI=$G(^DIC(36,INS,3))
; MRD;IB*2.0*516 - Removed logic pertaining to using VAMC as billing provider.
;S FLG=$G(^DIC(36,INS,4))
;S FLGP=+$P(FLG,U,11) ; prof switchback flag
;S FLGI=+$P(FLG,U,12) ; inst switchback flag
S PROFID=$P(EDI,U,2)
S INSTID=$P(EDI,U,4)
; MRD;IB*2.0*516 - Added HPID/OEID.
S IBHPID=$$HPD^IBCNHUT1(INS,1)
;
I IBRBID,PROFID'="",INSTID'="",$$UP^XLFSTR(PROFID)'["PRNT",$$UP^XLFSTR(INSTID)'["PRNT" G CALCX
;
S NAME=$P(DATA,U,1) S:NAME="" NAME="~UNK"
S STREET=$P(ADDR,U,1)
S CITY=$P(ADDR,U,4)
S STATE=+$P(ADDR,U,5)
S STATE=$S(STATE:$P($G(^DIC(5,STATE,0)),U,2),1:"")
S TYPCOV=$$EXTERNAL^DILFD(36,.13,,$P(DATA,U,13))
S TRANS=$$EXTERNAL^DILFD(36,3.01,,$P(EDI,U,1))
S INSTYP=$$EXTERNAL^DILFD(36,3.09,,$P(EDI,U,9))
; MRD;IB*2.0*516 - Removed logic pertaining to using VAMC as billing provider.
;S SWBCK="~" ; default no switchback flags set; sort these at the end
;I FLGP,FLGI S SWBCK="BOTH"
;I FLGP,'FLGI S SWBCK="PROF"
;I 'FLGP,FLGI S SWBCK="INST"
;
S SORT=" "
I IBRSORT=1,NAME'="" S SORT=" "_NAME
I IBRSORT=2,PROFID'="" S SORT=" "_PROFID
I IBRSORT=3,INSTID'="" S SORT=" "_INSTID
I IBRSORT=4,INSTYP'="" S SORT=" "_INSTYP
I IBRSORT=5,TYPCOV'="" S SORT=" "_TYPCOV
; MRD;IB*2.0*516 - Removed logic pertaining to using VAMC as billing provider.
;I IBRSORT=6,SWBCK'="" S SORT=" "_SWBCK
;
;S TMP=NAME_U_STREET_U_CITY_U_STATE_U_INSTYP_U_TYPCOV_U_TRANS_U_INSTID_U_PROFID_U_SWBCK
S TMP=NAME_U_STREET_U_CITY_U_STATE_U_INSTYP_U_TYPCOV_U_TRANS_U_INSTID_U_PROFID_U_IBHPID
S ^TMP($J,RTN,SORT,NAME,INS)=TMP
CALCX ;
Q
;
PRINT ; print the report to the specified device
NEW MAXCNT,CRT,PAGECNT,STOP,SORT,NAME,INS,DATA,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
I IOST["C-" S MAXCNT=IOSL-3,CRT=1
E S MAXCNT=IOSL-6,CRT=0
S PAGECNT=0,STOP=0
;
I '$D(^TMP($J,RTN)) D HEADER W !!!?5,"No Data Found"
;
; IB*2.0*521 add validated HPID to report and adjust Electronic type display
; MRD;IB*2.0*516 - Removed Bill Prov column, lengthened Electronic
; Type and Coverage Type.
;
S SORT=""
F S SORT=$O(^TMP($J,RTN,SORT)) Q:SORT="" D Q:STOP
. S NAME=""
. F S NAME=$O(^TMP($J,RTN,SORT,NAME)) Q:NAME="" D Q:STOP
.. S INS=0
.. F S INS=$O(^TMP($J,RTN,SORT,NAME,INS)) Q:'INS D Q:STOP
... S DATA=$G(^TMP($J,RTN,SORT,NAME,INS))
... I $P(DATA,U,10)["~" S $P(DATA,U,10)=""
... I $Y+1>MAXCNT!'PAGECNT D HEADER Q:STOP
... W !,$E($P(DATA,U,1),1,25) ; name
... W ?27,$E($P(DATA,U,2),1,19) ; address1
... W ?47,$E($P(DATA,U,3),1,13) ; city, st
... I $P(DATA,U,3)'="",$P(DATA,U,4)'="" W ","
... W $E($P(DATA,U,4),1,2)
... W ?65,$E($P(DATA,U,7),1,8) ; transmit elec
... W ?75,$E($P(DATA,U,8),1,8) ; inst payer id
... W ?84,$E($P(DATA,U,9),1,8) ; prof payer id
... W ?93,$E($P(DATA,U,10),1,11) ; HPID/OEID
... ;W ?94,$E($P(DATA,U,5),1,12) ; ins type
... ;W ?108,$E($P(DATA,U,6),1,18) ; type of cov
... W ?105,$S($E($P(DATA,U,5))="G":"GROUP PLAN",1:$E($P(DATA,U,5),1,10)) ; ins type
... W ?116,$E($P(DATA,U,6),1,16) ; type of cov
... ;W ?128,$E($P(DATA,U,10),1,4) ; switchback flag
... Q
.. Q
. Q
;
I STOP G PRINTX
W !!?5,"*** End of Report ***"
I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
PRINTX ;
Q
;
NEW LIN,HDR,TAB,C1,C2
S STOP=0
I CRT,PAGECNT>0,'$D(ZTQUEUED) D I STOP G HEADX
. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
. I 'Y S STOP=1 Q
. Q
;
S PAGECNT=PAGECNT+1
W @IOF,!
;
I IBRINS="A" W "All Companies"
I IBRINS="S" W "Selected Companies"
I IBRINS="R" D ; range description
. S C1=IBRINS1 I C1=" " S C1="First"
. S C2=IBRINS2 I C2="~~~~~" S C2="Last"
. W "Companies [",C1,"] through [",C2,"]"
. Q
;
W ?45," Insurance Company EDI Parameter Report"
S HDR="Page: "_PAGECNT,TAB=132-$L(HDR)-1
W ?TAB,HDR
;
W !,"Sorted By "
I IBRSORT=1 W "Ins Company Name"
I IBRSORT=2 W "Prof ID"
I IBRSORT=3 W "Inst ID"
I IBRSORT=4 W "Electronic Type"
I IBRSORT=5 W "Type of Coverage"
;I IBRSORT=6 W "Use VAMC as Billing Provider" ; MRD;IB*2.0*516
S HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z"),TAB=132-$L(HDR)-1
W ?TAB,HDR
;
; IB*2.0*521 add validated HPID to report
; MRD;IB*2.0*516 - Removed Bill Prov column, lengthened Electronic
; Type and Coverage Type.
;
;W !,"Only Blank or 'PRNT' Bill ID's = ",$S(IBRBID:"YES",1:"NO"),?128,"VAMC"
W !,"Only Blank or 'PRNT' Bill ID's = ",$S(IBRBID:"YES",1:"NO")
W !,"'*' indicates the HPID/OEID failed validation checks"
;W !?65,"Electron",?75,"Inst",?84,"Prof",?94,"Electronic",?128,"Bill" ; Removed by 521.
;W !?65,"Electron",?75,"Inst",?84,"Prof",?93,"HPID/",?102,"Electronic",?128,"Bill" ; Removed by 516.
W !?65,"Electron",?75,"Inst",?84,"Prof",?93,"HPID/",?105,"Electronic"
W !,"Insurance Company Name",?27,"Street Address",?47,"City"
;W ?65,"Transmit",?76,"ID",?85,"ID",?97,"Type",?108,"Type of Coverage",?128,"Prov" ; Removed by 521.
;W ?65,"Transmit",?76,"ID",?85,"ID",?93,"OEID",?105,"Type",?113,"Coverage Type",?128,"Prov" ; Removed by 516.
W ?65,"Transmit",?76,"ID",?85,"ID",?93,"OEID",?105,"Type",?116,"Coverage Type"
W !,$$RJ^XLFSTR("",132,"=")
;
; check for a stop request
I $D(ZTQUEUED),$$S^%ZTLOAD() D G HEADX
. S (ZTSTOP,STOP)=1
. W !!!?5,"*** Report Halted by TaskManager Request ***"
. Q
HEADX ;
Q
;
DEVICE ; Device selection before compile
NEW ZTRTN,ZTDESC,ZTSAVE,POP
W !!!,"This report is 132 columns wide. Please choose an appropriate device.",!
S ZTRTN="COMPILE^IBCNSGE"
S ZTDESC="Insurance Company EDI Parameter Report"
S ZTSAVE("IBRINS")=""
S ZTSAVE("IBRBID")=""
S ZTSAVE("IBRINS1")=""
S ZTSAVE("IBRINS2")=""
S ZTSAVE("IBRSORT")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
DEVX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSGE 11265 printed Dec 13, 2024@02:17:08 Page 2
IBCNSGE ;ALB/ESG - Insurance Company EDI Parameter Report ;07-JAN-2005
+1 ;;2.0;INTEGRATED BILLING;**296,400,521,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; eClaims Plus
+5 ; Identify insurance companies and display EDI parameter information.
+6 ;
+7 ;
EN ; Entry Point
+1 NEW IBRINS,IBRBID,IBRINS1,IBRINS2,IBRSORT,STOP
+2 DO SELECT
IF STOP
GOTO EXIT
+3 DO SORT
IF STOP
GOTO EXIT
+4 DO DEVICE
EXIT ;
+1 QUIT
+2 ;
SELECT ; Select insurance companies to include on the report
+1 NEW DIR,DIC,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBQ
SEL1 ;
+1 SET STOP=0
SET IBQ=0
+2 WRITE @IOF
+3 WRITE !!?21,"Insurance Company EDI Parameter Report"
+4 WRITE !!?5,"This report will display the EDI parameter information for selected"
+5 WRITE !?5,"insurance companies. You can specify one company, multiple companies,"
+6 WRITE !?5,"a range of company names, or all companies on file."
+7 ;
+8 SET DIR(0)="SO^A:Include All Insurance Companies;S:Select Specific Insurance Companies;R:Specify a Range of Insurance Company Names"
+9 SET DIR("A")=" Method for selecting insurance companies"
+10 SET DIR("B")="A"
+11 SET DIR("?",1)="Enter a code from the list. This defines how you want to select insurance"
+12 SET DIR("?",2)="companies for this report."
+13 SET DIR("?",3)=""
+14 SET DIR("?",4)="If you choose 'A', then all active companies will be included."
+15 SET DIR("?",5)="If you choose 'S', then one or more specific companies can be selected."
+16 SET DIR("?")="If you choose 'R', then you can enter a range of company names."
+17 DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
SET STOP=1
GOTO SELX
+19 SET IBRINS=Y
+20 IF '$FIND(".A.S.R.","."_IBRINS_".")
SET STOP=1
GOTO SELX
+21 ; choose one or many
IF IBRINS="S"
DO MULT
IF IBQ
GOTO SEL1
+22 ; choose a range
IF IBRINS="R"
DO RANGE
IF IBQ
GOTO SEL1
+23 ;
+24 WRITE !
+25 SET DIR(0)="YO"
+26 SET DIR("A",1)="Only include Insurance Companies with Electronic"
+27 SET DIR("A")=" Bill ID's that are blank or contain ""PRNT"""
+28 SET DIR("B")="NO"
+29 SET DIR("?",1)="Enter either 'Y' or 'N'. If you choose 'Y', then this will limit the selection"
+30 SET DIR("?",2)="of insurance companies. Only those companies in which the Inst ID or the Prof"
+31 SET DIR("?",3)="ID is either blank or contains ""PRNT"" (uppercase or lowercase)"
+32 SET DIR("?")="will be included."
+33 DO ^DIR
KILL DIR
+34 IF $DATA(DIRUT)
SET STOP=1
GOTO SELX
+35 SET IBRBID=Y
SELX ;
+1 QUIT
+2 ;
MULT ; select one or many insurance companies
+1 NEW DIC,X,Y
+2 KILL IBRINS
SET IBRINS="S"
+3 FOR
Begin DoDot:1
+4 WRITE !
SET DIC("A")="Insurance Company: "
+5 ; screen out Inactives
SET DIC("S")="I $$ACTIVE^IBCNEUT4(Y)"
+6 SET DIC=36
SET DIC(0)="AEQM"
DO ^DIC
+7 if Y'>0
QUIT
+8 SET IBRINS(+Y)=$PIECE($GET(^DIC(36,+Y,0)),U,1)
+9 QUIT
End DoDot:1
if Y'>0
QUIT
+10 ; none selected
IF $ORDER(IBRINS(""))=""
SET IBQ=1
GOTO MULTX
MULTX ;
+1 QUIT
+2 ;
RANGE ; select a range of insurance company names
+1 KILL IBRINS1,IBRINS2
+2 WRITE !
+3 SET DIR(0)="FO"
SET DIR("A")="Start with Insurance Company"
+4 SET DIR("?",1)="This response can be free text."
+5 SET DIR("?",2)="Responses are case sensitive."
+6 SET DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna."
+7 SET DIR("B")="First"
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET IBQ=1
GOTO RANGEX
+9 SET IBRINS1=Y
+10 IF IBRINS1="First"
SET IBRINS1=" "
+11 ;
+12 WRITE !
+13 SET DIR(0)="FO"
SET DIR("A")="Go to Insurance Company"
+14 SET DIR("?",1)="This response can be free text."
+15 SET DIR("?",2)="Responses are case sensitive."
+16 SET DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna."
+17 SET DIR("B")="Last"
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
SET IBQ=1
GOTO RANGEX
+19 SET IBRINS2=Y
+20 IF IBRINS2="Last"
SET IBRINS2="~~~~~"
+21 ;
+22 IF IBRINS1=" "
IF IBRINS2="~~~~~"
Begin DoDot:1
+23 KILL IBRINS,IBRINS1,IBRINS2
+24 SET IBRINS="A"
+25 QUIT
End DoDot:1
GOTO RANGEX
+26 ;
+27 IF IBRINS1]IBRINS2
Begin DoDot:1
+28 WRITE !!?5,"Sorry ..... Ending name must come after Starting name"
+29 WRITE !!?5,"Please try again",*7
+30 QUIT
End DoDot:1
GOTO RANGE
+31 ;
RANGEX ;
+1 QUIT
+2 ;
SORT ; Choose the sorting method
+1 ; MRD;IB*2.0*516 - Removed sort option 6, Use VAMC as Billing Provider.
+2 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+3 WRITE !!?5,"*** Sort Criteria ***"
+4 ;S DIR(0)="SO^1:Insurance Company Name;2:Prof Electronic Bill ID;3:Inst Electronic Bill ID;4:Electronic Type;5:Type Of Coverage;6:Use VAMC as Billing Provider"
+5 SET DIR(0)="SO^1:Insurance Company Name;2:Prof Electronic Bill ID;3:Inst Electronic Bill ID;4:Electronic Type;5:Type Of Coverage"
+6 SET DIR("A")="Sort By"
SET DIR("B")=1
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
SET STOP=1
GOTO SORTX
+9 SET IBRSORT=Y
SORTX ;
+1 QUIT
+2 ;
COMPILE ; Entry point for task; compile scratch global, print, clean-up
+1 ;
+2 NEW RTN,INSIEN,INSNM,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY
+3 NEW STATE,TYPCOV,TRANS,INSTYP,SORT,TMP,IBHPID
+4 ;
+5 SET RTN="IBCNSGE"
+6 ; init
KILL ^TMP($JOB,RTN)
+7 ;
+8 ; all insurances
+9 IF IBRINS="A"
Begin DoDot:1
+10 SET INSIEN=0
+11 FOR
SET INSIEN=$ORDER(^DIC(36,INSIEN))
if 'INSIEN
QUIT
DO CALC(INSIEN)
+12 QUIT
End DoDot:1
+13 ;
+14 ; specific insurances
+15 IF IBRINS="S"
Begin DoDot:1
+16 SET INSIEN=0
+17 FOR
SET INSIEN=$ORDER(IBRINS(INSIEN))
if 'INSIEN
QUIT
DO CALC(INSIEN)
+18 QUIT
End DoDot:1
+19 ;
+20 ; a range of insurances
+21 IF IBRINS="R"
Begin DoDot:1
+22 SET INSNM=$ORDER(^DIC(36,"B",IBRINS1),-1)
+23 FOR
SET INSNM=$ORDER(^DIC(36,"B",INSNM))
if INSNM=""
QUIT
if INSNM]IBRINS2
QUIT
Begin DoDot:2
+24 SET INSIEN=0
+25 FOR
SET INSIEN=$ORDER(^DIC(36,"B",INSNM,INSIEN))
if 'INSIEN
QUIT
DO CALC(INSIEN)
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 ;
+29 ; print the report
DO PRINT
+30 ; close the device
DO ^%ZISC
+31 ; kill scratch global
KILL ^TMP($JOB,RTN)
+32 ; purge the task record
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
COMPX ;
+1 QUIT
+2 ;
CALC(INS) ; extract insurance data for company ien=INS
+1 ;
+2 ; not active
IF '$$ACTIVE^IBCNEUT4(INS)
GOTO CALCX
+3 SET DATA=$GET(^DIC(36,INS,0))
+4 SET ADDR=$GET(^DIC(36,INS,.11))
+5 SET EDI=$GET(^DIC(36,INS,3))
+6 ; MRD;IB*2.0*516 - Removed logic pertaining to using VAMC as billing provider.
+7 ;S FLG=$G(^DIC(36,INS,4))
+8 ;S FLGP=+$P(FLG,U,11) ; prof switchback flag
+9 ;S FLGI=+$P(FLG,U,12) ; inst switchback flag
+10 SET PROFID=$PIECE(EDI,U,2)
+11 SET INSTID=$PIECE(EDI,U,4)
+12 ; MRD;IB*2.0*516 - Added HPID/OEID.
+13 SET IBHPID=$$HPD^IBCNHUT1(INS,1)
+14 ;
+15 IF IBRBID
IF PROFID'=""
IF INSTID'=""
IF $$UP^XLFSTR(PROFID)'["PRNT"
IF $$UP^XLFSTR(INSTID)'["PRNT"
GOTO CALCX
+16 ;
+17 SET NAME=$PIECE(DATA,U,1)
if NAME=""
SET NAME="~UNK"
+18 SET STREET=$PIECE(ADDR,U,1)
+19 SET CITY=$PIECE(ADDR,U,4)
+20 SET STATE=+$PIECE(ADDR,U,5)
+21 SET STATE=$SELECT(STATE:$PIECE($GET(^DIC(5,STATE,0)),U,2),1:"")
+22 SET TYPCOV=$$EXTERNAL^DILFD(36,.13,,$PIECE(DATA,U,13))
+23 SET TRANS=$$EXTERNAL^DILFD(36,3.01,,$PIECE(EDI,U,1))
+24 SET INSTYP=$$EXTERNAL^DILFD(36,3.09,,$PIECE(EDI,U,9))
+25 ; MRD;IB*2.0*516 - Removed logic pertaining to using VAMC as billing provider.
+26 ;S SWBCK="~" ; default no switchback flags set; sort these at the end
+27 ;I FLGP,FLGI S SWBCK="BOTH"
+28 ;I FLGP,'FLGI S SWBCK="PROF"
+29 ;I 'FLGP,FLGI S SWBCK="INST"
+30 ;
+31 SET SORT=" "
+32 IF IBRSORT=1
IF NAME'=""
SET SORT=" "_NAME
+33 IF IBRSORT=2
IF PROFID'=""
SET SORT=" "_PROFID
+34 IF IBRSORT=3
IF INSTID'=""
SET SORT=" "_INSTID
+35 IF IBRSORT=4
IF INSTYP'=""
SET SORT=" "_INSTYP
+36 IF IBRSORT=5
IF TYPCOV'=""
SET SORT=" "_TYPCOV
+37 ; MRD;IB*2.0*516 - Removed logic pertaining to using VAMC as billing provider.
+38 ;I IBRSORT=6,SWBCK'="" S SORT=" "_SWBCK
+39 ;
+40 ;S TMP=NAME_U_STREET_U_CITY_U_STATE_U_INSTYP_U_TYPCOV_U_TRANS_U_INSTID_U_PROFID_U_SWBCK
+41 SET TMP=NAME_U_STREET_U_CITY_U_STATE_U_INSTYP_U_TYPCOV_U_TRANS_U_INSTID_U_PROFID_U_IBHPID
+42 SET ^TMP($JOB,RTN,SORT,NAME,INS)=TMP
CALCX ;
+1 QUIT
+2 ;
PRINT ; print the report to the specified device
+1 NEW MAXCNT,CRT,PAGECNT,STOP,SORT,NAME,INS,DATA,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT
+2 IF IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+3 IF '$TEST
SET MAXCNT=IOSL-6
SET CRT=0
+4 SET PAGECNT=0
SET STOP=0
+5 ;
+6 IF '$DATA(^TMP($JOB,RTN))
DO HEADER
WRITE !!!?5,"No Data Found"
+7 ;
+8 ; IB*2.0*521 add validated HPID to report and adjust Electronic type display
+9 ; MRD;IB*2.0*516 - Removed Bill Prov column, lengthened Electronic
+10 ; Type and Coverage Type.
+11 ;
+12 SET SORT=""
+13 FOR
SET SORT=$ORDER(^TMP($JOB,RTN,SORT))
if SORT=""
QUIT
Begin DoDot:1
+14 SET NAME=""
+15 FOR
SET NAME=$ORDER(^TMP($JOB,RTN,SORT,NAME))
if NAME=""
QUIT
Begin DoDot:2
+16 SET INS=0
+17 FOR
SET INS=$ORDER(^TMP($JOB,RTN,SORT,NAME,INS))
if 'INS
QUIT
Begin DoDot:3
+18 SET DATA=$GET(^TMP($JOB,RTN,SORT,NAME,INS))
+19 IF $PIECE(DATA,U,10)["~"
SET $PIECE(DATA,U,10)=""
+20 IF $Y+1>MAXCNT!'PAGECNT
DO HEADER
if STOP
QUIT
+21 ; name
WRITE !,$EXTRACT($PIECE(DATA,U,1),1,25)
+22 ; address1
WRITE ?27,$EXTRACT($PIECE(DATA,U,2),1,19)
+23 ; city, st
WRITE ?47,$EXTRACT($PIECE(DATA,U,3),1,13)
+24 IF $PIECE(DATA,U,3)'=""
IF $PIECE(DATA,U,4)'=""
WRITE ","
+25 WRITE $EXTRACT($PIECE(DATA,U,4),1,2)
+26 ; transmit elec
WRITE ?65,$EXTRACT($PIECE(DATA,U,7),1,8)
+27 ; inst payer id
WRITE ?75,$EXTRACT($PIECE(DATA,U,8),1,8)
+28 ; prof payer id
WRITE ?84,$EXTRACT($PIECE(DATA,U,9),1,8)
+29 ; HPID/OEID
WRITE ?93,$EXTRACT($PIECE(DATA,U,10),1,11)
+30 ;W ?94,$E($P(DATA,U,5),1,12) ; ins type
+31 ;W ?108,$E($P(DATA,U,6),1,18) ; type of cov
+32 ; ins type
WRITE ?105,$SELECT($EXTRACT($PIECE(DATA,U,5))="G":"GROUP PLAN",1:$EXTRACT($PIECE(DATA,U,5),1,10))
+33 ; type of cov
WRITE ?116,$EXTRACT($PIECE(DATA,U,6),1,16)
+34 ;W ?128,$E($P(DATA,U,10),1,4) ; switchback flag
+35 QUIT
End DoDot:3
if STOP
QUIT
+36 QUIT
End DoDot:2
if STOP
QUIT
+37 QUIT
End DoDot:1
if STOP
QUIT
+38 ;
+39 IF STOP
GOTO PRINTX
+40 WRITE !!?5,"*** End of Report ***"
+41 IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
KILL DIR
PRINTX ;
+1 QUIT
+2 ;
+1 NEW LIN,HDR,TAB,C1,C2
+2 SET STOP=0
+3 IF CRT
IF PAGECNT>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+4 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+5 SET DIR(0)="E"
DO ^DIR
KILL DIR
+6 IF 'Y
SET STOP=1
QUIT
+7 QUIT
End DoDot:1
IF STOP
GOTO HEADX
+8 ;
+9 SET PAGECNT=PAGECNT+1
+10 WRITE @IOF,!
+11 ;
+12 IF IBRINS="A"
WRITE "All Companies"
+13 IF IBRINS="S"
WRITE "Selected Companies"
+14 ; range description
IF IBRINS="R"
Begin DoDot:1
+15 SET C1=IBRINS1
IF C1=" "
SET C1="First"
+16 SET C2=IBRINS2
IF C2="~~~~~"
SET C2="Last"
+17 WRITE "Companies [",C1,"] through [",C2,"]"
+18 QUIT
End DoDot:1
+19 ;
+20 WRITE ?45," Insurance Company EDI Parameter Report"
+21 SET HDR="Page: "_PAGECNT
SET TAB=132-$LENGTH(HDR)-1
+22 WRITE ?TAB,HDR
+23 ;
+24 WRITE !,"Sorted By "
+25 IF IBRSORT=1
WRITE "Ins Company Name"
+26 IF IBRSORT=2
WRITE "Prof ID"
+27 IF IBRSORT=3
WRITE "Inst ID"
+28 IF IBRSORT=4
WRITE "Electronic Type"
+29 IF IBRSORT=5
WRITE "Type of Coverage"
+30 ;I IBRSORT=6 W "Use VAMC as Billing Provider" ; MRD;IB*2.0*516
+31 SET HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z")
SET TAB=132-$LENGTH(HDR)-1
+32 WRITE ?TAB,HDR
+33 ;
+34 ; IB*2.0*521 add validated HPID to report
+35 ; MRD;IB*2.0*516 - Removed Bill Prov column, lengthened Electronic
+36 ; Type and Coverage Type.
+37 ;
+38 ;W !,"Only Blank or 'PRNT' Bill ID's = ",$S(IBRBID:"YES",1:"NO"),?128,"VAMC"
+39 WRITE !,"Only Blank or 'PRNT' Bill ID's = ",$SELECT(IBRBID:"YES",1:"NO")
+40 WRITE !,"'*' indicates the HPID/OEID failed validation checks"
+41 ;W !?65,"Electron",?75,"Inst",?84,"Prof",?94,"Electronic",?128,"Bill" ; Removed by 521.
+42 ;W !?65,"Electron",?75,"Inst",?84,"Prof",?93,"HPID/",?102,"Electronic",?128,"Bill" ; Removed by 516.
+43 WRITE !?65,"Electron",?75,"Inst",?84,"Prof",?93,"HPID/",?105,"Electronic"
+44 WRITE !,"Insurance Company Name",?27,"Street Address",?47,"City"
+45 ;W ?65,"Transmit",?76,"ID",?85,"ID",?97,"Type",?108,"Type of Coverage",?128,"Prov" ; Removed by 521.
+46 ;W ?65,"Transmit",?76,"ID",?85,"ID",?93,"OEID",?105,"Type",?113,"Coverage Type",?128,"Prov" ; Removed by 516.
+47 WRITE ?65,"Transmit",?76,"ID",?85,"ID",?93,"OEID",?105,"Type",?116,"Coverage Type"
+48 WRITE !,$$RJ^XLFSTR("",132,"=")
+49 ;
+50 ; check for a stop request
+51 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
Begin DoDot:1
+52 SET (ZTSTOP,STOP)=1
+53 WRITE !!!?5,"*** Report Halted by TaskManager Request ***"
+54 QUIT
End DoDot:1
GOTO HEADX
HEADX ;
+1 QUIT
+2 ;
DEVICE ; Device selection before compile
+1 NEW ZTRTN,ZTDESC,ZTSAVE,POP
+2 WRITE !!!,"This report is 132 columns wide. Please choose an appropriate device.",!
+3 SET ZTRTN="COMPILE^IBCNSGE"
+4 SET ZTDESC="Insurance Company EDI Parameter Report"
+5 SET ZTSAVE("IBRINS")=""
+6 SET ZTSAVE("IBRBID")=""
+7 SET ZTSAVE("IBRINS1")=""
+8 SET ZTSAVE("IBRINS2")=""
+9 SET ZTSAVE("IBRSORT")=""
+10 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM")
DEVX ;
+1 QUIT
+2 ;
