IBCEQ2 ;ALB/TMK - PROVIDER/BILLING ID WORKSHEET ;18-AUG-04
;;2.0;INTEGRATED BILLING;**282**;21-MAR-94
;
; WORKSHEET TO IDENTIFY BC/BS AND TRICARE PLANS THAT MAY NEED SPECIAL
; SET UP FOR PERFORMING PROVIDER OR BILLING PROVIDER IDS
;
EN ;
N POP,ZTSAVE,%ZIS,ZTSK,ZTRTN,ZTDESC,DIR,X,Y,DUOUT,DTOUT,Z,IBPG,IBSTOP,IBBL
;
S DIR("A")="PRINT (P)RE-PRINTED, (B)LANK FORM, (S)OLUTIONS?: ",DIR(0)="SA^P:PRE-PRINTED;B:BLANK FORM;S:SOLUTIONS"
S DIR("B")="PRE-PRINTED" W ! D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
S IBBL=$P(Y,U)
I $P(Y,U)="B" D Q:$D(DTOUT)!$D(DUOUT)
. S DIR(0)="NA^1:100",DIR("A")="NUMBER OF BLANK FORMS TO PRINT: ",DIR("B")=1 W ! D ^DIR K DIR
. S $P(IBBL,U,2)=+Y
I $P(IBBL,U)'["S" D Q:$D(DTOUT)!$D(DUOUT)
. S DIR(0)="YA",DIR("B")="NO",DIR("A")="DO YOU WANT TO PRINT THE SOLUTIONS TOO?: " D ^DIR K DIR
. I Y=1 S $P(IBBL,U)=$P(IBBL,U)_"S"
S %ZIS="QM" D ^%ZIS G:POP EN1Q
I $D(IO("Q")) D G EN1Q
. S ZTRTN="ENQ^IBCEQ2",ZTDESC="IB - HIPAA ENHANCEMENTS PERF/BILLING PROV ID WORKSHEET",ZTSAVE("IBBL")=""
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Task # "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
D ENQ
EN1Q Q
;
ENQ ; Queued job enters here
;
N X,Z,Z0,Z00,IBI0,IBPAYR,IBPG,IBSTOP,IBCT,TYPCOV,IBCTI,IBLOOP,IBCOPY,IBTYPE
K ^TMP($J)
I $P(IBBL,U)["P" D
. S Z=0 F S Z=$O(^DIC(36,Z)) Q:'Z D
.. S IBI0=$G(^DIC(36,Z,0)),IBPAYR=$P(IBI0,U)
.. Q:$P(IBI0,U,5) ; ins co inactive
.. S TYPCOV=$P(IBI0,U,13) ; type of cov ien;file 355.2
.. S Z0=$P($G(^IBE(355.2,+TYPCOV,0)),U,2)
.. I $S(Z0="TRI":0,Z0="CHS":0,Z0="BC":0,1:Z0'="BS") Q ; Not Tricare or BC/BS
.. S X=$S(Z0="TRI"!(Z0="CHS"):"TRICARE",Z0="BC":"BLUE CROSS",1:"BLUE SHIELD")
.. S ^TMP($J,"IB",0_U_X,$E(IBPAYR,1,25)_U_Z)=IBPAYR,^TMP($J,"IB",0_U_X,$E(IBPAYR,1,25)_U_Z,0)=$G(^DIC(36,Z,.11))
. ;
. S ^TMP($J,"IB","1^"," ")=""
;
I $P(IBBL,U,2) S ^TMP($J,"IB",1_U," ")=$P(IBBL,U,2)
S (IBPG,IBSTOP,IBCTI)=0
S Z="" F S Z=$O(^TMP($J,"IB",Z)) Q:Z="" D Q:IBSTOP
. I $D(ZTQUEUED),$$S^%ZTLOAD S (IBSTOP,ZTSTOP)=1 K ZTREQ W:IBPG !,"***TASK STOPPED BY USER***" Q
. S IBCOPY=$S($P(Z,U,2)'="":1,1:+$G(^TMP($J,"IB",Z," "))) S:'IBCOPY IBCOPY=1
. F IBLOOP=1:1:IBCOPY D Q:IBSTOP
.. D HDR(Z,.IBPG,.IBSTOP)
.. Q:IBSTOP
.. ;
.. S Z0="",IBCT=0 F S Z0=$O(^TMP($J,"IB",Z,Z0)) Q:Z0="" S Z00=$G(^(Z0,0)) D
... I IBCT'<5 S IBCT=0 D HDR(Z,.IBPG,.IBSTOP) Q:IBSTOP
... S IBCT=IBCT+1
... D BOX($G(^TMP($J,"IB",Z,Z0)),Z00,.IBCTI)
.. ;
.. I IBCT'>4 F IBCT=IBCT+1:1:5 D BOX("","")
;
I 'IBSTOP,$P(IBBL,U)["S" D
. N IBZ,IBTEXT,IBLINE,IBDONE,X,Q,Z
. S IBPG=0
. I $P(IBBL,U)'="S" D ASK(.IBSTOP) Q:IBSTOP W @IOF
. D HDR1^IBCEQ2A(.IBPG)
. ;
. S IBDONE=0,(IBLINE,IBTYPE,IBOTYPE)=""
. F Z=1:1 D Q:IBDONE
.. S IBZ=$P($T(SOLUTION+Z),";;",2)
.. I IBZ="" S IBDONE=1 Q
.. S IBLINE(+$O(IBLINE(" "),-1)+1,$P(IBZ,U,2))=$P(IBZ,U,3)
. ;
. S Z=0 F S Z=$O(IBLINE(Z)) Q:'Z D
.. S IBTYPE=$O(IBLINE(Z,"")) Q:IBTYPE=""
.. S IBTEXT=$G(IBLINE(Z,IBTYPE))
.. ;
.. I $E(IBTYPE)="S" D S IBOTYPE="S" Q
... I IBOTYPE'="S" D WRTS^IBCEQ2A("S",IBOTYPE,.IBTEXT,.IBSTOP) I IBSTOP S IBDONE=1 Q
... I $P(IBTYPE,"S",2) F Q=1:1:$P(IBTYPE,"S",2) W !
... W IBTEXT
.. ;
.. D WRTS^IBCEQ2A(IBTYPE,IBOTYPE,.IBTEXT,.IBSTOP) I IBSTOP S IBDONE=1 Q
.. S IBOTYPE=IBTYPE
. I 'IBSTOP,$O(IBTEXT("")) S IBTEXT="" D WRTS^IBCEQ2A("",IBOTYPE,.IBTEXT,.IBSTOP)
I '$D(ZTQUEUED) D ^%ZISC I 'IBSTOP,IBPG D ASK()
I $D(ZTQUEUED),'IBSTOP S ZTREQ="@"
K ^TMP($J)
Q
;
BOX(IBINM,Z00,IBCTI) ;
N Q,X
S:$TR(Z00," ")="" IBINM=""
S:IBINM'="" IBCTI=IBCTI+1
W !,"!",$E($S($TR(IBINM," ")'="":"("_IBCTI_")"_IBINM,1:"")_$J("",30),1,30),"!",$J("",$S(IOM<132:23,1:49)),"!",$J("",$S(IOM<132:23,1:49)),"!"
W !,"!",$E($P(Z00,U)_$J("",30),1,30),"!",$J("",$S(IOM<132:23,1:49)),"!",$J("",$S(IOM<132:23,1:49)),"!"
W !,"!",$E($P(Z00,U,2)_$J("",30),1,30),"!",$J("",$S(IOM<132:23,1:49)),"!",$J("",$S(IOM<132:23,1:49)),"!"
W !,"!",$E($P(Z00,U,3)_$J("",30),1,30),"!",$J("",$S(IOM<132:23,1:49)),"!",$J("",$S(IOM<132:23,1:49)),"!"
W !,"!",$E($P(Z00,U,4)_" "_$P($G(^DIC(5,+$P(Z00,U,5),0)),U,2)_" "_$P(Z00,U,6)_$J("",30),1,30),"!",$J("",$S(IOM<132:23,1:49)),"!",$J("",$S(IOM<132:23,1:49)),"!"
F Q=1:1:2 W !,"!",$J("",30),"!",$J("",$S(IOM<132:23,1:49)),"!",$J("",$S(IOM<132:23,1:49)),"!"
S X="",$P(X,"-",IOM+1)="" W !,X
Q
;
HDR(IBINM,IBPG,IBSTOP) ; Ins Co info
N X,IBINMX
I IBPG D ASK(.IBSTOP) Q:IBSTOP W @IOF
S IBPG=IBPG+1
S IBINMX=+IBINM,IBINM=$P(IBINM,U,2)
W !,$S(IBINM="":"",1:$$FMTE^XLFDT(DT,"2D")),?(IOM-39\2),"INSURANCE COMPANY PROVIDER ID WORKSHEET" W:IBINM'="" ?(70+$S(IOM<132:0,1:52)),"PAGE: ",IBPG
I IBINM'="" S X="INSURANCE COMPANY TYPE: "_IBINM W !,?(IOM-$L(X)\2),X
W !
I 'IBINMX D
. W !,"**** ENTER THE SPECIAL PERFORMING AND BILLING PROVIDER ID REQUIREMENTS",!," FOR THE LISTED INSURANCE COMPANIES IN THE BOXES PROVIDED"
I IBINMX D
. W !,"**** ENTER THE NAMES OF ANY INSURANCE COMPANIES THAT HAVE SPECIAL ID",!," REQUIREMENTS FOR YOUR SITE AND THEN ENTER THE SPECIFIC REQUIREMENTS IN",!," THE BOXES PROVIDED."
S X="",$P(X,"-",IOM+1)=""
W !,X,!,"! !"_$J("",$S(IOM<132:1,1:14))_"SECONDARY PERFORMING"_$J("",$S(IOM<132:2,1:15))_"!"_$J("",$S(IOM<132:8,1:21))_"BILLING"_$J("",$S(IOM<132:8,1:21)),"!"
W !,"! !"_$J("",$S(IOM<132:3,1:16))_"PROV. ID SPECIFIC"_$J("",$S(IOM<132:3,1:16))_"!"_$J("",$S(IOM<132:3,1:16))_"PROV. ID SPECIFIC"_$J("",$S(IOM<132:3,1:16))_"!"
W !,"! INSURANCE COMPANY !"_$J("",$S(IOM<132:0,1:13))_"REQUIREMENTS (SCREEN 8)"_$J("",$S(IOM<132:0,1:13))_"!"_$J("",$S(IOM<132:0,1:13))_"REQUIREMENTS (SCREEN 3)"_$J("",$S(IOM<132:0,1:13))_"!"
W !,X
W !,"!"_$J("",30)_"!"_$J("",$S(IOM<132:23,1:49))_"!"_$J("",$S(IOM<132:23,1:49))_"!"
W !,"!*** example: !"_$J("",$S(IOM<132:1,1:14))_"requires specific IDs"_$J("",$S(IOM<132:1,1:14))_"!"_$J("",$S(IOM<132:1,1:14))_"requires specific ids"_$J("",$S(IOM<132:1,1:14))_"!"
W !,"! insurance co name !"_$J("",$S(IOM<132:2,1:15))_"for each specialty"_$J("",$S(IOM<132:3,1:16))_"!"_$J("",$S(IOM<132:3,1:16))_"for each division"_$J("",$S(IOM<132:3,1:16))_"!"
W !,X
Q
;
ASK(IBSTOP) ; Ask continue
; If passed by ref, IBSTOP returned = 1 if print aborted
I $E(IOST,1,2)'["C-" Q
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="E" W ! D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S IBSTOP=1 Q
Q
;
SOLUTION ; Solution text
;;^S0^ *********************** SCREEN 8 IDs ***********************"
;;^S1^
;;^Q^****FOR ALL OF THE FOLLOWING SCENARIOS, YOU MUST FIRST SET UP THE PERFORMING PROVIDER SECONDARY ID PARAMETERS FOR THE PAYER****
;;^A^Use the INSURANCE COMPANY ENTRY/EDIT (EI) option to set up the payer's id parameters. Select the insurance company, and the PROVIDER ID PARAMS (ID) action to set up the PERFORMING PROVIDER SECONDARY ID TYPE for each form type
;;^A^ and the flag for whether the ids are required or not. Reference page 38 in the EDI USER'S GUIDE for help on setting up the id parameters.
;;^S1^
;;^Q^1. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID FOR THE SITE:
;;^A^Use Provider ID Maintenance option 2 (INSURANCE CO IDS) and set up an id for the PROVIDER ID TYPE specified by the payer. Do not choose a provider when prompted.
;;^A^ Enter the form types/care types this id will be used for and the appropriate id. Reference pages 39-42 in the EDI USER'S GUIDE for more help on setting up the id.
;;^S1^
;;^Q^2. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID AS ASSIGNED TO EACH PROVIDER AT THE SITE:
;;^A^Follow the same set up for the payer's secondary id parameters as noted in 1 above. Use Provider ID Maintenance option 2 (INSURANCE CO IDS) and set up an id for the PROVIDER ID TYPE specified by the payer.
;;^A^ Choose a provider when prompted. Enter the form types/care types this id will be used for and the appropriate id.
;;^A^ Repeat these steps for each provider whose services can be billed to this payer. Reference pages 42-44 in the EDI USER'S GUIDE for more help on setting up the id.
;;^S1^
;;^Q^3. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID AS ASSIGNED TO EACH SPECIALTY AT THE SITE:
;;^A^Use the Provider ID Maintenance option 4 (CARE UNIT MAINTENANCE) and set up an entry for each specialty that has a specific id.
;;^A^ Follow the same steps in either 1 or 2 above to set up the ids. There will be one extra prompt for care unit. Enter the name of the SPECIALTY for the id.
;;^A^ Reference pages 50-55 in the EDI USER'S GUIDE for more help.
;;^S1^
;;^Q^4. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID AS ASSIGNED TO EACH DIVISION AT THE SITE:
;;^A^Follow the same steps as for specialty (#3 above) except the care units will be DIVISIONS instead of SPECIALTIES.
;;^S3^ *********************** SCREEN 3 IDs ***********************
;;^S1^
;;^Q^1. PAYER REQUIRES ONE BILLING FACILITY PRIMARY ID FOR THE SITE:
;;^A^Use the INSURANCE COMPANY ENTRY/EDIT option (EI) and make sure there is an id number set up for each form type. If not, add the ids using the facility's main billing division as the division.
;;^A^ Reference pages 25-27 in the EDI USERS GUIDE for more help.
;;^S1^
;;^Q^2. PAYER REQUIRES ONE BILLING FACILITY PRIMARY ID AS ASSIGNED TO EACH DIVISION AT THE SITE:
;;^A^Use the INSURANCE COMPANY ENTRY/EDIT option (EI) and choose the insurance company. Choose action Billing Parameters (BP), respond YES TO EDIT BILLING FACILITY PRIMARY IDs.
;;^A^ Choose the ADD action and define the ids for each division that requires a special id. Reference pages 25-27 in the EDI USERS GUIDE for more help.
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEQ2 9727 printed Apr 09, 2024@21:17:37 Page 2
IBCEQ2 ;ALB/TMK - PROVIDER/BILLING ID WORKSHEET ;18-AUG-04
+1 ;;2.0;INTEGRATED BILLING;**282**;21-MAR-94
+2 ;
+3 ; WORKSHEET TO IDENTIFY BC/BS AND TRICARE PLANS THAT MAY NEED SPECIAL
+4 ; SET UP FOR PERFORMING PROVIDER OR BILLING PROVIDER IDS
+5 ;
EN ;
+1 NEW POP,ZTSAVE,%ZIS,ZTSK,ZTRTN,ZTDESC,DIR,X,Y,DUOUT,DTOUT,Z,IBPG,IBSTOP,IBBL
+2 ;
+3 SET DIR("A")="PRINT (P)RE-PRINTED, (B)LANK FORM, (S)OLUTIONS?: "
SET DIR(0)="SA^P:PRE-PRINTED;B:BLANK FORM;S:SOLUTIONS"
+4 SET DIR("B")="PRE-PRINTED"
WRITE !
DO ^DIR
KILL DIR
+5 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 SET IBBL=$PIECE(Y,U)
+7 IF $PIECE(Y,U)="B"
Begin DoDot:1
+8 SET DIR(0)="NA^1:100"
SET DIR("A")="NUMBER OF BLANK FORMS TO PRINT: "
SET DIR("B")=1
WRITE !
DO ^DIR
KILL DIR
+9 SET $PIECE(IBBL,U,2)=+Y
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+10 IF $PIECE(IBBL,U)'["S"
Begin DoDot:1
+11 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A")="DO YOU WANT TO PRINT THE SOLUTIONS TOO?: "
DO ^DIR
KILL DIR
+12 IF Y=1
SET $PIECE(IBBL,U)=$PIECE(IBBL,U)_"S"
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+13 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EN1Q
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTRTN="ENQ^IBCEQ2"
SET ZTDESC="IB - HIPAA ENHANCEMENTS PERF/BILLING PROV ID WORKSHEET"
SET ZTSAVE("IBBL")=""
+16 DO ^%ZTLOAD
+17 WRITE !!,$SELECT($DATA(ZTSK):"Task # "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+18 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO EN1Q
+19 USE IO
+20 DO ENQ
EN1Q QUIT
+1 ;
ENQ ; Queued job enters here
+1 ;
+2 NEW X,Z,Z0,Z00,IBI0,IBPAYR,IBPG,IBSTOP,IBCT,TYPCOV,IBCTI,IBLOOP,IBCOPY,IBTYPE
+3 KILL ^TMP($JOB)
+4 IF $PIECE(IBBL,U)["P"
Begin DoDot:1
+5 SET Z=0
FOR
SET Z=$ORDER(^DIC(36,Z))
if 'Z
QUIT
Begin DoDot:2
+6 SET IBI0=$GET(^DIC(36,Z,0))
SET IBPAYR=$PIECE(IBI0,U)
+7 ; ins co inactive
if $PIECE(IBI0,U,5)
QUIT
+8 ; type of cov ien;file 355.2
SET TYPCOV=$PIECE(IBI0,U,13)
+9 SET Z0=$PIECE($GET(^IBE(355.2,+TYPCOV,0)),U,2)
+10 ; Not Tricare or BC/BS
IF $SELECT(Z0="TRI":0,Z0="CHS":0,Z0="BC":0,1:Z0'="BS")
QUIT
+11 SET X=$SELECT(Z0="TRI"!(Z0="CHS"):"TRICARE",Z0="BC":"BLUE CROSS",1:"BLUE SHIELD")
+12 SET ^TMP($JOB,"IB",0_U_X,$EXTRACT(IBPAYR,1,25)_U_Z)=IBPAYR
SET ^TMP($JOB,"IB",0_U_X,$EXTRACT(IBPAYR,1,25)_U_Z,0)=$GET(^DIC(36,Z,.11))
End DoDot:2
+13 ;
+14 SET ^TMP($JOB,"IB","1^"," ")=""
End DoDot:1
+15 ;
+16 IF $PIECE(IBBL,U,2)
SET ^TMP($JOB,"IB",1_U," ")=$PIECE(IBBL,U,2)
+17 SET (IBPG,IBSTOP,IBCTI)=0
+18 SET Z=""
FOR
SET Z=$ORDER(^TMP($JOB,"IB",Z))
if Z=""
QUIT
Begin DoDot:1
+19 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (IBSTOP,ZTSTOP)=1
KILL ZTREQ
if IBPG
WRITE !,"***TASK STOPPED BY USER***"
QUIT
+20 SET IBCOPY=$SELECT($PIECE(Z,U,2)'="":1,1:+$GET(^TMP($JOB,"IB",Z," ")))
if 'IBCOPY
SET IBCOPY=1
+21 FOR IBLOOP=1:1:IBCOPY
Begin DoDot:2
+22 DO HDR(Z,.IBPG,.IBSTOP)
+23 if IBSTOP
QUIT
+24 ;
+25 SET Z0=""
SET IBCT=0
FOR
SET Z0=$ORDER(^TMP($JOB,"IB",Z,Z0))
if Z0=""
QUIT
SET Z00=$GET(^(Z0,0))
Begin DoDot:3
+26 IF IBCT'<5
SET IBCT=0
DO HDR(Z,.IBPG,.IBSTOP)
if IBSTOP
QUIT
+27 SET IBCT=IBCT+1
+28 DO BOX($GET(^TMP($JOB,"IB",Z,Z0)),Z00,.IBCTI)
End DoDot:3
+29 ;
+30 IF IBCT'>4
FOR IBCT=IBCT+1:1:5
DO BOX("","")
End DoDot:2
if IBSTOP
QUIT
End DoDot:1
if IBSTOP
QUIT
+31 ;
+32 IF 'IBSTOP
IF $PIECE(IBBL,U)["S"
Begin DoDot:1
+33 NEW IBZ,IBTEXT,IBLINE,IBDONE,X,Q,Z
+34 SET IBPG=0
+35 IF $PIECE(IBBL,U)'="S"
DO ASK(.IBSTOP)
if IBSTOP
QUIT
WRITE @IOF
+36 DO HDR1^IBCEQ2A(.IBPG)
+37 ;
+38 SET IBDONE=0
SET (IBLINE,IBTYPE,IBOTYPE)=""
+39 FOR Z=1:1
Begin DoDot:2
+40 SET IBZ=$PIECE($TEXT(SOLUTION+Z),";;",2)
+41 IF IBZ=""
SET IBDONE=1
QUIT
+42 SET IBLINE(+$ORDER(IBLINE(" "),-1)+1,$PIECE(IBZ,U,2))=$PIECE(IBZ,U,3)
End DoDot:2
if IBDONE
QUIT
+43 ;
+44 SET Z=0
FOR
SET Z=$ORDER(IBLINE(Z))
if 'Z
QUIT
Begin DoDot:2
+45 SET IBTYPE=$ORDER(IBLINE(Z,""))
if IBTYPE=""
QUIT
+46 SET IBTEXT=$GET(IBLINE(Z,IBTYPE))
+47 ;
+48 IF $EXTRACT(IBTYPE)="S"
Begin DoDot:3
+49 IF IBOTYPE'="S"
DO WRTS^IBCEQ2A("S",IBOTYPE,.IBTEXT,.IBSTOP)
IF IBSTOP
SET IBDONE=1
QUIT
+50 IF $PIECE(IBTYPE,"S",2)
FOR Q=1:1:$PIECE(IBTYPE,"S",2)
WRITE !
+51 WRITE IBTEXT
End DoDot:3
SET IBOTYPE="S"
QUIT
+52 ;
+53 DO WRTS^IBCEQ2A(IBTYPE,IBOTYPE,.IBTEXT,.IBSTOP)
IF IBSTOP
SET IBDONE=1
QUIT
+54 SET IBOTYPE=IBTYPE
End DoDot:2
+55 IF 'IBSTOP
IF $ORDER(IBTEXT(""))
SET IBTEXT=""
DO WRTS^IBCEQ2A("",IBOTYPE,.IBTEXT,.IBSTOP)
End DoDot:1
+56 IF '$DATA(ZTQUEUED)
DO ^%ZISC
IF 'IBSTOP
IF IBPG
DO ASK()
+57 IF $DATA(ZTQUEUED)
IF 'IBSTOP
SET ZTREQ="@"
+58 KILL ^TMP($JOB)
+59 QUIT
+60 ;
BOX(IBINM,Z00,IBCTI) ;
+1 NEW Q,X
+2 if $TRANSLATE(Z00," ")=""
SET IBINM=""
+3 if IBINM'=""
SET IBCTI=IBCTI+1
+4 WRITE !,"!",$EXTRACT($SELECT($TRANSLATE(IBINM," ")'="":"("_IBCTI_")"_IBINM,1:"")_$JUSTIFY("",30),1,30),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!"
+5 WRITE !,"!",$EXTRACT($PIECE(Z00,U)_$JUSTIFY("",30),1,30),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!"
+6 WRITE !,"!",$EXTRACT($PIECE(Z00,U,2)_$JUSTIFY("",30),1,30),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!"
+7 WRITE !,"!",$EXTRACT($PIECE(Z00,U,3)_$JUSTIFY("",30),1,30),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!"
+8 WRITE !,"!",$EXTRACT($PIECE(Z00,U,4)_" "_$PIECE($GET(^DIC(5,+$PIECE(Z00,U,5),0)),U,2)_" "_$PIECE(Z00,U,6)_$JUSTIFY("",30),1,30),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!"
+9 FOR Q=1:1:2
WRITE !,"!",$JUSTIFY("",30),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!",$JUSTIFY("",$SELECT(IOM<132:23,1:49)),"!"
+10 SET X=""
SET $PIECE(X,"-",IOM+1)=""
WRITE !,X
+11 QUIT
+12 ;
HDR(IBINM,IBPG,IBSTOP) ; Ins Co info
+1 NEW X,IBINMX
+2 IF IBPG
DO ASK(.IBSTOP)
if IBSTOP
QUIT
WRITE @IOF
+3 SET IBPG=IBPG+1
+4 SET IBINMX=+IBINM
SET IBINM=$PIECE(IBINM,U,2)
+5 WRITE !,$SELECT(IBINM="":"",1:$$FMTE^XLFDT(DT,"2D")),?(IOM-39\2),"INSURANCE COMPANY PROVIDER ID WORKSHEET"
if IBINM'=""
WRITE ?(70+$SELECT(IOM<132:0,1:52)),"PAGE: ",IBPG
+6 IF IBINM'=""
SET X="INSURANCE COMPANY TYPE: "_IBINM
WRITE !,?(IOM-$LENGTH(X)\2),X
+7 WRITE !
+8 IF 'IBINMX
Begin DoDot:1
+9 WRITE !,"**** ENTER THE SPECIAL PERFORMING AND BILLING PROVIDER ID REQUIREMENTS",!," FOR THE LISTED INSURANCE COMPANIES IN THE BOXES PROVIDED"
End DoDot:1
+10 IF IBINMX
Begin DoDot:1
+11 WRITE !,"**** ENTER THE NAMES OF ANY INSURANCE COMPANIES THAT HAVE SPECIAL ID",!," REQUIREMENTS FOR YOUR SITE AND THEN ENTER THE SPECIFIC REQUIREMENTS IN",!," THE BOXES PROVIDED."
End DoDot:1
+12 SET X=""
SET $PIECE(X,"-",IOM+1)=""
+13 WRITE !,X,!,"! !"_$JUSTIFY("",$SELECT(IOM<132:1,1:14))_"SECONDARY PERFORMING"_$JUSTIFY("",$SELECT(IOM<132:2,1:15))_"!"_$JUSTIFY("",$SELECT(IOM<132:8,1:21))_"BILLING"_$JUSTIFY("",$SELECT(IOM<132:8,1:21)),"!"
+14 WRITE !,"! !"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"PROV. ID SPECIFIC"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"!"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"PROV. ID SPECIFIC"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"!"
+15 WRITE !,"! INSURANCE COMPANY !"_$JUSTIFY("",$SELECT(IOM<132:0,1:13))_"REQUIREMENTS (SCREEN 8)"_$JUSTIFY("",$SELECT(IOM<132:0,1:13))_"!"_$JUSTIFY("",$SELECT(IOM<132:0,1:13))_"REQUIREMENTS (SCREEN 3)"_$JUSTIFY("",$SELECT(IOM<132:0,1:13
))_"!"
+16 WRITE !,X
+17 WRITE !,"!"_$JUSTIFY("",30)_"!"_$JUSTIFY("",$SELECT(IOM<132:23,1:49))_"!"_$JUSTIFY("",$SELECT(IOM<132:23,1:49))_"!"
+18 WRITE !,"!*** example: !"_$JUSTIFY("",$SELECT(IOM<132:1,1:14))_"requires specific IDs"_$JUSTIFY("",$SELECT(IOM<132:1,1:14))_"!"_$JUSTIFY("",$SELECT(IOM<132:1,1:14))_"requires specific ids"_$JUSTIFY("",$SELECT(IOM<132:1,1:14))_"
!"
+19 WRITE !,"! insurance co name !"_$JUSTIFY("",$SELECT(IOM<132:2,1:15))_"for each specialty"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"!"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"for each division"_$JUSTIFY("",$SELECT(IOM<132:3,1:16))_"!"
+20 WRITE !,X
+21 QUIT
+22 ;
ASK(IBSTOP) ; Ask continue
+1 ; If passed by ref, IBSTOP returned = 1 if print aborted
+2 IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 SET DIR(0)="E"
WRITE !
DO ^DIR
+5 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET IBSTOP=1
QUIT
+6 QUIT
+7 ;
SOLUTION ; Solution text
+1 ;;^S0^ *********************** SCREEN 8 IDs ***********************"
+2 ;;^S1^
+3 ;;^Q^****FOR ALL OF THE FOLLOWING SCENARIOS, YOU MUST FIRST SET UP THE PERFORMING PROVIDER SECONDARY ID PARAMETERS FOR THE PAYER****
+4 ;;^A^Use the INSURANCE COMPANY ENTRY/EDIT (EI) option to set up the payer's id parameters. Select the insurance company, and the PROVIDER ID PARAMS (ID) action to set up the PERFORMING PROVIDER SECONDARY ID TYPE for each form type
+5 ;;^A^ and the flag for whether the ids are required or not. Reference page 38 in the EDI USER'S GUIDE for help on setting up the id parameters.
+6 ;;^S1^
+7 ;;^Q^1. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID FOR THE SITE:
+8 ;;^A^Use Provider ID Maintenance option 2 (INSURANCE CO IDS) and set up an id for the PROVIDER ID TYPE specified by the payer. Do not choose a provider when prompted.
+9 ;;^A^ Enter the form types/care types this id will be used for and the appropriate id. Reference pages 39-42 in the EDI USER'S GUIDE for more help on setting up the id.
+10 ;;^S1^
+11 ;;^Q^2. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID AS ASSIGNED TO EACH PROVIDER AT THE SITE:
+12 ;;^A^Follow the same set up for the payer's secondary id parameters as noted in 1 above. Use Provider ID Maintenance option 2 (INSURANCE CO IDS) and set up an id for the PROVIDER ID TYPE specified by the payer.
+13 ;;^A^ Choose a provider when prompted. Enter the form types/care types this id will be used for and the appropriate id.
+14 ;;^A^ Repeat these steps for each provider whose services can be billed to this payer. Reference pages 42-44 in the EDI USER'S GUIDE for more help on setting up the id.
+15 ;;^S1^
+16 ;;^Q^3. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID AS ASSIGNED TO EACH SPECIALTY AT THE SITE:
+17 ;;^A^Use the Provider ID Maintenance option 4 (CARE UNIT MAINTENANCE) and set up an entry for each specialty that has a specific id.
+18 ;;^A^ Follow the same steps in either 1 or 2 above to set up the ids. There will be one extra prompt for care unit. Enter the name of the SPECIALTY for the id.
+19 ;;^A^ Reference pages 50-55 in the EDI USER'S GUIDE for more help.
+20 ;;^S1^
+21 ;;^Q^4. PAYER REQUIRES ONE PERFORMING PROVIDER SECONDARY ID AS ASSIGNED TO EACH DIVISION AT THE SITE:
+22 ;;^A^Follow the same steps as for specialty (#3 above) except the care units will be DIVISIONS instead of SPECIALTIES.
+23 ;;^S3^ *********************** SCREEN 3 IDs ***********************
+24 ;;^S1^
+25 ;;^Q^1. PAYER REQUIRES ONE BILLING FACILITY PRIMARY ID FOR THE SITE:
+26 ;;^A^Use the INSURANCE COMPANY ENTRY/EDIT option (EI) and make sure there is an id number set up for each form type. If not, add the ids using the facility's main billing division as the division.
+27 ;;^A^ Reference pages 25-27 in the EDI USERS GUIDE for more help.
+28 ;;^S1^
+29 ;;^Q^2. PAYER REQUIRES ONE BILLING FACILITY PRIMARY ID AS ASSIGNED TO EACH DIVISION AT THE SITE:
+30 ;;^A^Use the INSURANCE COMPANY ENTRY/EDIT option (EI) and choose the insurance company. Choose action Billing Parameters (BP), respond YES TO EDIT BILLING FACILITY PRIMARY IDs.
+31 ;;^A^ Choose the ADD action and define the ids for each division that requires a special id. Reference pages 25-27 in the EDI USERS GUIDE for more help.
+32 ;
