IBCEQ1A ;ALB/BSL,TMK - PROVIDER ID QUERY REPORT ;25-AUG-03
;;2.0;INTEGRATED BILLING;**232,348,349,516,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
RPTOUT ; Print from data in ^XTMP
N IBP,IBA,IBI,IBIN,IBPNM,IBPNUM,IBSTOP,IBX,IBZ,IBPG,IBICONT,Z
K ^TMP($J,"IBZ232")
F Z=1:1:6 S ^TMP($J,"IBZ232",Z)=""
S (IBPG,IBSTOP)=0
S IBA=0 F S IBA=$O(^XTMP("IB_PLAN232",1,IBA)) Q:'IBA D
. S IBX=$G(^XTMP("IB_PLAN232",1,IBA,0))
. ; Sort by err type, ins co ien
. S ^TMP($J,"IBZ232",+$P(IBX,U,16),+$P(IBX,U,11),IBA)=IBX
;
S IBZ=0 F S IBZ=$O(^TMP($J,"IBZ232",IBZ)) Q:'IBZ!IBSTOP!(IBZ>6) D HDR1(.IBPG,.IBSTOP,IBZ,0) S IBI=0 F S IBI=$O(^TMP($J,"IBZ232",IBZ,IBI)) Q:'IBI!IBSTOP D
. S IBIN=$P($G(^DIC(36,+IBI,0)),U)_" ("_$S(+$G(^(3))=1:"",1:"NOT ")_"SET TO TRANSMIT LIVE)"
. D INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,0) S IBICONT=0
. S IBA=0 F S IBA=$O(^TMP($J,"IBZ232",IBZ,IBI,IBA)) Q:'IBA!IBSTOP S IBX=$G(^(IBA)) D
.. I ($Y+5)>IOSL D INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,IBICONT) Q:IBSTOP
.. ;
.. I IBZ'=4,IBZ'=5 D
... S IBP=+$P(IBX,U,14)
... I $P(IBX,U,14)[".91" S IBPNM="ALL PROVIDERS"
... I $P(IBX,U,14)'[".91" D
.... N Z
.... S Z=$P($G(^IBA(355.9,IBP,0)),U)
.... S IBPNM=$S(Z["VA(200":"",1:"#")_$$EXTERNAL^DILFD(355.9,.01,"",Z)
... S IBPNUM=$P($G(^IBA(+$P($P(IBX,U,14),";",2),IBP,0)),U,7)
... D WRT(1," "_$E($P("ALL^UB-04^CMS-1500",U,$P(IBX,U,4)+1)_$J("",9),1,9)_" "_$E($P(IBX,U,15)_$J("",23),1,23)_" "_$E(IBPNM_$J("",28),1,28)_" "_$E(IBPNUM,1,11))
.. ;
.. I IBZ=4!(IBZ=5) D
... ;IB*516/TAZ - Change Group Name from piece 3 to field 2.01, and group Number from piece 4 to field 2.02
... ;N Z
... N GNUM,GNAM,EPTYP
... ;S Z=$G(^IBA(355.3,+$P(IBX,U,13),0))
... ;D WRT(1," "_$E($P(Z,U,3)_$J("",20),1,20)_" "_$E($P(Z,U,4)_$J("",17),1,17)_" "_$$EXTERNAL^DILFD(355.3,.15,"",$P(Z,U,15)))
... S GNUM=$$GET1^DIQ(355.3,+$P(IBX,U,13)_",",2.02) ;Group Number
... S GNAM=$$GET1^DIQ(355.3,+$P(IBX,U,13)_",",2.01) ;Group Name
... S EPTYP=$$GET1^DIQ(355.3,+$P(IBX,U,13)_",",.15) ;Electronic Plan Type
... D WRT(1," "_$E(GNUM_$J("",20),1,20)_" "_$E(GNAM_$J("",17),1,17)_" "_EPTYP)
.. S:'IBICONT IBICONT=1
;
I 'IBSTOP D ;Totals
. N Z
. S Z=$G(^XTMP("IB_PLAN232"))
. I ($Y+10)>IOSL!'IBPG D HDR(.IBPG,.IBSTOP,"") Q:IBSTOP
. D WRT(2,$J("",25)_"TOTAL # OF IDs CHECKED: "_+$P(Z,U,4))
. D WRT(1,$J("",14)_"TOT # BLUE CROSS/SHIELD IDS FOUND: "_+$P(Z,U,5))
. D WRT(1,"TOTAL # OF INS CO. W/BLUE PLANS AND NO BLUE IDS: "_+$P(Z,U,3))
. D WRT(1,$J("",21)_"TOTAL # OF ERRORS/WARNINGS: "_+$P(Z,U,6))
;
I '$D(ZTQUEUED) D ^%ZISC I 'IBSTOP,IBPG D ASK()
I $D(ZTQUEUED),'IBSTOP S ZTREQ="@"
I $G(^TMP($J,"SENDMSG")),'IBSTOP D
. N XMDUZ,XMSUBJ,XMBODY,XMTO,XMZ
. S XMDUZ=DUZ,XMSUBJ=$E("PROVIDER ID QUERY FROM "_$P($G(^DIC(4,+$P($G(^IBE(350.9,1,0)),U,2),0)),U),1,65),XMBODY="^TMP($J,""SENDMSG"",1)"
. M XMTO=^TMP($J,"SENDMSG",0)
. S Z="" F S Z=$O(^TMP($J,"SENDMSG",0,Z)) Q:Z="" S XMZ(Z)=""
. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,"",.XMZ)
K ^TMP($J,"IBZ232"),^TMP($J,"SENDMSG")
Q
;
HDR(IBPG,IBSTOP,IBZ,FF) ; Main hdr
; FF = 0 if continuation pg so it writes it to report, but not mail msg
N Z,IBT
Q:$G(IBSTOP)
I $D(ZTQUEUED),$$S^%ZTLOAD S (IBSTOP,ZTSTOP)=1 K ZTREQ I +$G(IBPG) D WRT(2,"***TASK STOPPED BY USER***") Q
I IBPG&($E(IOST,1,2)="C-") D ASK(.IBSTOP) Q:IBSTOP
S IBT=$S(IBPG:1,1:0)
S IBPG=IBPG+1
S Z="PROVIDER ID VERIFICATION QUERY REPORT"
S Z=$$SETSTR^VALM1($J("",80-$L(Z)\2)_Z,"",1,79)
S Z=$$SETSTR^VALM1("Page: "_IBPG,Z,70,10)
D WRT(0,"@IOF",$G(FF))
D WRT(1,Z,$G(FF))
S Z="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z=$J("",80-$L(Z)\2)_Z
D WRT(1,Z,$G(FF))
I IBZ'="",IBZ'=4,IBZ'=5 D
. D WRT(2," FORM TYPE PROV ID TYPE"_$J("",12)_"PROVIDER NAME (#=Non-VA)"_$J("",6)_"PROV ID",$G(FF))
I IBZ=4!(IBZ=5) D
. D WRT(2," GROUP NAME"_$J("",12)_"GROUP NUMBER"_$J("",7)_"ELECTRONIC PLAN TYPE",$G(FF))
D WRT(1,$TR($J("",IOM-1)," ","-"),$G(FF))
Q
;
HDR1(IBPG,IBSTOP,IBZ,IBCONT) ; Hdr err typ
N Z,Z0,Z1
D HDR(.IBPG,.IBSTOP,IBZ,IBCONT) Q:IBSTOP
S Z="",$P(Z,"*",80)="" D WRT(1,Z,IBCONT)
S Z0="* "_$S(IBZ>1:"WARNING: ",1:"ERROR: ")
;
I IBZ'=4,IBZ'=5 D
. N X
. S X="BLUE CROSS ID FOUND FOR A 1500 FORM TYPE ONLY^BLUE SHIELD ID FOUND FOR A UB-04 FORM TYPE ONLY^BLUE CROSS ID FOUND FOR ALL FORM TYPES^BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC PLAN TYPE"
. S Z0=Z0_$S(IBZ<6:$P(X,U,IBZ),IBZ=6:"""VAD000"" PROVIDER ID FOUND NOT SET UP AS A UPIN PROVIDER ID TYPE",1:"")
I IBZ=4 D
. S Z0=Z0_"BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. S Z0="*"_$J("",10)_"PLAN TYPE"
;
I IBZ=5 D
. S Z0=Z0_"INSURANCE CO HAS BL CROSS/SHIELD PLANS, BUT NO BL CROSS/SHIELD IDs"
;
S Z0=Z0_$S(IBCONT:" (CONT)",1:"")
D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
;
I 'IBCONT D
. I IBZ=1 D
.. D WRT(1,"*"_$J("",77)_"*",IBCONT)
.. S Z0="* SOLUTION: THIS ID WILL NEVER BE USED ELECTRONICALLY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",11)_"CHANGE PROVIDER ID TYPE TO BLUE SHIELD IF THIS ID SHOULD BE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",11)_"TRANSMITTED ON A 1500." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. ;
. I IBZ=2 D
.. D WRT(1,"*"_$J("",77)_"*",IBCONT)
.. S Z0="* SUGGESTION: VISTA WILL TRANSMIT THIS ID ELECTRONICALLY, BUT IT IS OPTIMAL" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"TO HAVE THIS ID SET UP AS BLUE CROSS." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. ;
. I IBZ=3 D
.. D WRT(1,"*"_$J("",77)_"*",IBCONT)
.. S Z0="* SUGGESTION: A BLUE CROSS ID CAN ONLY BE APPLIED TO A UB-04 FORM TYPE." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"EDIT THE 'APPLIED TO FORM TYPE' FOR THE ID TO BE UB-04 ONLY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"IF YOU NEED THIS ID ON A 1500, SET IT UP AS A BLUE SHIELD ID" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"APPLIED TO A CMS-1500 FORM TYPE." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. ;
. I IBZ=4 D
.. D WRT(1,"*"_$J("",77)_"*",IBCONT)
.. S Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD ID IS DEFINED FOR THE INSURANCE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"COMPANY, BUT THE ELECTRONIC PLAN TYPE FOR ONE OR MORE OF THE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"COMPANY'S PLANS IS NOT SET TO 'BL' (BLUE CROSS/BLUE SHIELD)." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"IF BLUE CROSS/BLUE SHIELD IDs ARE NEEDED TO PRINT FOR ANY" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"OF THESE PLANS, ITS ELECTRONIC PLAN TYPE MUST BE CHANGED TO BL." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. ;
. I IBZ=5 D
.. D WRT(1,"*"_$J("",77)_"*",IBCONT)
.. S Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD PLAN IS DEFINED FOR THE INSURANCE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"COMPANY, BUT YOU HAVE ONLY NON-BLUE CROSS/SHIELD IDS SET UP." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"YOU MUST SET UP THE APPROPRIATE BLUE CROSS/BLUE SHIELD IDs" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"FOR THE INSURANCE COMPANY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. ;
. I IBZ=6 D
.. D WRT(1,"*"_$J("",77)_"*",IBCONT)
.. S Z0="* SUGGESTION: CHANGE PROVIDER ID TYPE TO UPIN."
.. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"ONCE ALL PAYERS FULLY IMPLEMENT HIPAA EDITS, YOU"
.. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
.. S Z0="*"_$J("",13)_"MUST USE THE CORRECT ID TYPE FOR THE ID ENTERED."
.. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
. ;
. D WRT(1,"*"_$J("",77)_"*",IBCONT)
. S Z1="*"_$J("",$S(IBZ'=1:13,1:11))_"VISTA OPTION TO USE: "
. I IBZ'=4 D
.. S Z0=Z1_"PROVIDER ID MAINTENANCE"
. I IBZ=4 D
.. S Z0=Z1_"INSURANCE COMPANY ENTRY/EDIT"
. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
;
D WRT(1,Z,IBCONT)
;
I '$O(^TMP($J,"IBZ232",IBZ,0)) D WRT(2,"***** NOTHING FOUND FOR THIS ERROR/WARNING *****",IBCONT)
Q
;
INSHDR(IBPG,IBSTOP,IBINM,IBZ,IBICONT) ; Ins Co info
I ($Y+7)>IOSL D HDR1(.IBPG,.IBSTOP,IBZ,1)
Q:IBSTOP
D WRT(2,"INSURANCE CO NAME: "_IBINM_$S($G(IBICONT):" (Continued)",1:""),IBICONT)
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
;
WRT(FF,TEXT,NOT) ; Wrt/store line
N Z,A
S A=+$O(^TMP($J,"SENDMSG",1,""),-1),NOT=$G(NOT)
I FF F Z=1:1:FF W ! I $G(^TMP($J,"SENDMSG")),'NOT,Z>1 S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
;
I TEXT="@IOF" D Q
. W @IOF
. I $G(^TMP($J,"SENDMSG")),'NOT,IBPG>1 D
.. S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
.. F Z=1:1:2 S A=A+1,^TMP($J,"SENDMSG",1,A)="*** TOP OF NEW PAGE ***"
.. S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
;
W TEXT
I $G(^TMP($J,"SENDMSG")),'NOT S A=A+1,^TMP($J,"SENDMSG",1,A)=TEXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEQ1A 9073 printed Dec 13, 2024@02:12:10 Page 2
IBCEQ1A ;ALB/BSL,TMK - PROVIDER ID QUERY REPORT ;25-AUG-03
+1 ;;2.0;INTEGRATED BILLING;**232,348,349,516,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
RPTOUT ; Print from data in ^XTMP
+1 NEW IBP,IBA,IBI,IBIN,IBPNM,IBPNUM,IBSTOP,IBX,IBZ,IBPG,IBICONT,Z
+2 KILL ^TMP($JOB,"IBZ232")
+3 FOR Z=1:1:6
SET ^TMP($JOB,"IBZ232",Z)=""
+4 SET (IBPG,IBSTOP)=0
+5 SET IBA=0
FOR
SET IBA=$ORDER(^XTMP("IB_PLAN232",1,IBA))
if 'IBA
QUIT
Begin DoDot:1
+6 SET IBX=$GET(^XTMP("IB_PLAN232",1,IBA,0))
+7 ; Sort by err type, ins co ien
+8 SET ^TMP($JOB,"IBZ232",+$PIECE(IBX,U,16),+$PIECE(IBX,U,11),IBA)=IBX
End DoDot:1
+9 ;
+10 SET IBZ=0
FOR
SET IBZ=$ORDER(^TMP($JOB,"IBZ232",IBZ))
if 'IBZ!IBSTOP!(IBZ>6)
QUIT
DO HDR1(.IBPG,.IBSTOP,IBZ,0)
SET IBI=0
FOR
SET IBI=$ORDER(^TMP($JOB,"IBZ232",IBZ,IBI))
if 'IBI!IBSTOP
QUIT
Begin DoDot:1
+11 SET IBIN=$PIECE($GET(^DIC(36,+IBI,0)),U)_" ("_$SELECT(+$GET(^(3))=1:"",1:"NOT ")_"SET TO TRANSMIT LIVE)"
+12 DO INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,0)
SET IBICONT=0
+13 SET IBA=0
FOR
SET IBA=$ORDER(^TMP($JOB,"IBZ232",IBZ,IBI,IBA))
if 'IBA!IBSTOP
QUIT
SET IBX=$GET(^(IBA))
Begin DoDot:2
+14 IF ($Y+5)>IOSL
DO INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,IBICONT)
if IBSTOP
QUIT
+15 ;
+16 IF IBZ'=4
IF IBZ'=5
Begin DoDot:3
+17 SET IBP=+$PIECE(IBX,U,14)
+18 IF $PIECE(IBX,U,14)[".91"
SET IBPNM="ALL PROVIDERS"
+19 IF $PIECE(IBX,U,14)'[".91"
Begin DoDot:4
+20 NEW Z
+21 SET Z=$PIECE($GET(^IBA(355.9,IBP,0)),U)
+22 SET IBPNM=$SELECT(Z["VA(200":"",1:"#")_$$EXTERNAL^DILFD(355.9,.01,"",Z)
End DoDot:4
+23 SET IBPNUM=$PIECE($GET(^IBA(+$PIECE($PIECE(IBX,U,14),";",2),IBP,0)),U,7)
+24 DO WRT(1," "_$EXTRACT($PIECE("ALL^UB-04^CMS-1500",U,$PIECE(IBX,U,4)+1)_$JUSTIFY("",9),1,9)_" "_$EXTRACT($PIECE(IBX,U,15)_$JUSTIFY("",23),1,23)_" "_$EXTRACT(IBPNM_$JUSTIFY("",28),1,28)_" "_$EXTRACT(IBPNUM,1,11
))
End DoDot:3
+25 ;
+26 IF IBZ=4!(IBZ=5)
Begin DoDot:3
+27 ;IB*516/TAZ - Change Group Name from piece 3 to field 2.01, and group Number from piece 4 to field 2.02
+28 ;N Z
+29 NEW GNUM,GNAM,EPTYP
+30 ;S Z=$G(^IBA(355.3,+$P(IBX,U,13),0))
+31 ;D WRT(1," "_$E($P(Z,U,3)_$J("",20),1,20)_" "_$E($P(Z,U,4)_$J("",17),1,17)_" "_$$EXTERNAL^DILFD(355.3,.15,"",$P(Z,U,15)))
+32 ;Group Number
SET GNUM=$$GET1^DIQ(355.3,+$PIECE(IBX,U,13)_",",2.02)
+33 ;Group Name
SET GNAM=$$GET1^DIQ(355.3,+$PIECE(IBX,U,13)_",",2.01)
+34 ;Electronic Plan Type
SET EPTYP=$$GET1^DIQ(355.3,+$PIECE(IBX,U,13)_",",.15)
+35 DO WRT(1," "_$EXTRACT(GNUM_$JUSTIFY("",20),1,20)_" "_$EXTRACT(GNAM_$JUSTIFY("",17),1,17)_" "_EPTYP)
End DoDot:3
+36 if 'IBICONT
SET IBICONT=1
End DoDot:2
End DoDot:1
+37 ;
+38 ;Totals
IF 'IBSTOP
Begin DoDot:1
+39 NEW Z
+40 SET Z=$GET(^XTMP("IB_PLAN232"))
+41 IF ($Y+10)>IOSL!'IBPG
DO HDR(.IBPG,.IBSTOP,"")
if IBSTOP
QUIT
+42 DO WRT(2,$JUSTIFY("",25)_"TOTAL # OF IDs CHECKED: "_+$PIECE(Z,U,4))
+43 DO WRT(1,$JUSTIFY("",14)_"TOT # BLUE CROSS/SHIELD IDS FOUND: "_+$PIECE(Z,U,5))
+44 DO WRT(1,"TOTAL # OF INS CO. W/BLUE PLANS AND NO BLUE IDS: "_+$PIECE(Z,U,3))
+45 DO WRT(1,$JUSTIFY("",21)_"TOTAL # OF ERRORS/WARNINGS: "_+$PIECE(Z,U,6))
End DoDot:1
+46 ;
+47 IF '$DATA(ZTQUEUED)
DO ^%ZISC
IF 'IBSTOP
IF IBPG
DO ASK()
+48 IF $DATA(ZTQUEUED)
IF 'IBSTOP
SET ZTREQ="@"
+49 IF $GET(^TMP($JOB,"SENDMSG"))
IF 'IBSTOP
Begin DoDot:1
+50 NEW XMDUZ,XMSUBJ,XMBODY,XMTO,XMZ
+51 SET XMDUZ=DUZ
SET XMSUBJ=$EXTRACT("PROVIDER ID QUERY FROM "_$PIECE($GET(^DIC(4,+$PIECE($GET(^IBE(350.9,1,0)),U,2),0)),U),1,65)
SET XMBODY="^TMP($J,""SENDMSG"",1)"
+52 MERGE XMTO=^TMP($JOB,"SENDMSG",0)
+53 SET Z=""
FOR
SET Z=$ORDER(^TMP($JOB,"SENDMSG",0,Z))
if Z=""
QUIT
SET XMZ(Z)=""
+54 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,"",.XMZ)
End DoDot:1
+55 KILL ^TMP($JOB,"IBZ232"),^TMP($JOB,"SENDMSG")
+56 QUIT
+57 ;
HDR(IBPG,IBSTOP,IBZ,FF) ; Main hdr
+1 ; FF = 0 if continuation pg so it writes it to report, but not mail msg
+2 NEW Z,IBT
+3 if $GET(IBSTOP)
QUIT
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (IBSTOP,ZTSTOP)=1
KILL ZTREQ
IF +$GET(IBPG)
DO WRT(2,"***TASK STOPPED BY USER***")
QUIT
+5 IF IBPG&($EXTRACT(IOST,1,2)="C-")
DO ASK(.IBSTOP)
if IBSTOP
QUIT
+6 SET IBT=$SELECT(IBPG:1,1:0)
+7 SET IBPG=IBPG+1
+8 SET Z="PROVIDER ID VERIFICATION QUERY REPORT"
+9 SET Z=$$SETSTR^VALM1($JUSTIFY("",80-$LENGTH(Z)\2)_Z,"",1,79)
+10 SET Z=$$SETSTR^VALM1("Page: "_IBPG,Z,70,10)
+11 DO WRT(0,"@IOF",$GET(FF))
+12 DO WRT(1,Z,$GET(FF))
+13 SET Z="RUN DATE: "_$$FMTE^XLFDT(DT,2)
SET Z=$JUSTIFY("",80-$LENGTH(Z)\2)_Z
+14 DO WRT(1,Z,$GET(FF))
+15 IF IBZ'=""
IF IBZ'=4
IF IBZ'=5
Begin DoDot:1
+16 DO WRT(2," FORM TYPE PROV ID TYPE"_$JUSTIFY("",12)_"PROVIDER NAME (#=Non-VA)"_$JUSTIFY("",6)_"PROV ID",$GET(FF))
End DoDot:1
+17 IF IBZ=4!(IBZ=5)
Begin DoDot:1
+18 DO WRT(2," GROUP NAME"_$JUSTIFY("",12)_"GROUP NUMBER"_$JUSTIFY("",7)_"ELECTRONIC PLAN TYPE",$GET(FF))
End DoDot:1
+19 DO WRT(1,$TRANSLATE($JUSTIFY("",IOM-1)," ","-"),$GET(FF))
+20 QUIT
+21 ;
HDR1(IBPG,IBSTOP,IBZ,IBCONT) ; Hdr err typ
+1 NEW Z,Z0,Z1
+2 DO HDR(.IBPG,.IBSTOP,IBZ,IBCONT)
if IBSTOP
QUIT
+3 SET Z=""
SET $PIECE(Z,"*",80)=""
DO WRT(1,Z,IBCONT)
+4 SET Z0="* "_$SELECT(IBZ>1:"WARNING: ",1:"ERROR: ")
+5 ;
+6 IF IBZ'=4
IF IBZ'=5
Begin DoDot:1
+7 NEW X
+8 SET X="BLUE CROSS ID FOUND FOR A 1500 FORM TYPE ONLY^BLUE SHIELD ID FOUND FOR A UB-04 FORM TYPE ONLY^BLUE CROSS ID FOUND FOR ALL FORM TYPES^BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC PLAN TYPE"
+9 SET Z0=Z0_$SELECT(IBZ<6:$PIECE(X,U,IBZ),IBZ=6:"""VAD000"" PROVIDER ID FOUND NOT SET UP AS A UPIN PROVIDER ID TYPE",1:"")
End DoDot:1
+10 IF IBZ=4
Begin DoDot:1
+11 SET Z0=Z0_"BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+12 SET Z0="*"_$JUSTIFY("",10)_"PLAN TYPE"
End DoDot:1
+13 ;
+14 IF IBZ=5
Begin DoDot:1
+15 SET Z0=Z0_"INSURANCE CO HAS BL CROSS/SHIELD PLANS, BUT NO BL CROSS/SHIELD IDs"
End DoDot:1
+16 ;
+17 SET Z0=Z0_$SELECT(IBCONT:" (CONT)",1:"")
+18 DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+19 ;
+20 IF 'IBCONT
Begin DoDot:1
+21 IF IBZ=1
Begin DoDot:2
+22 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+23 SET Z0="* SOLUTION: THIS ID WILL NEVER BE USED ELECTRONICALLY."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+24 SET Z0="*"_$JUSTIFY("",11)_"CHANGE PROVIDER ID TYPE TO BLUE SHIELD IF THIS ID SHOULD BE"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+25 SET Z0="*"_$JUSTIFY("",11)_"TRANSMITTED ON A 1500."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:2
+26 ;
+27 IF IBZ=2
Begin DoDot:2
+28 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+29 SET Z0="* SUGGESTION: VISTA WILL TRANSMIT THIS ID ELECTRONICALLY, BUT IT IS OPTIMAL"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+30 SET Z0="*"_$JUSTIFY("",13)_"TO HAVE THIS ID SET UP AS BLUE CROSS."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:2
+31 ;
+32 IF IBZ=3
Begin DoDot:2
+33 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+34 SET Z0="* SUGGESTION: A BLUE CROSS ID CAN ONLY BE APPLIED TO A UB-04 FORM TYPE."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+35 SET Z0="*"_$JUSTIFY("",13)_"EDIT THE 'APPLIED TO FORM TYPE' FOR THE ID TO BE UB-04 ONLY."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+36 SET Z0="*"_$JUSTIFY("",13)_"IF YOU NEED THIS ID ON A 1500, SET IT UP AS A BLUE SHIELD ID"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+37 SET Z0="*"_$JUSTIFY("",13)_"APPLIED TO A CMS-1500 FORM TYPE."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:2
+38 ;
+39 IF IBZ=4
Begin DoDot:2
+40 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+41 SET Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD ID IS DEFINED FOR THE INSURANCE"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+42 SET Z0="*"_$JUSTIFY("",13)_"COMPANY, BUT THE ELECTRONIC PLAN TYPE FOR ONE OR MORE OF THE"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+43 SET Z0="*"_$JUSTIFY("",13)_"COMPANY'S PLANS IS NOT SET TO 'BL' (BLUE CROSS/BLUE SHIELD)."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+44 SET Z0="*"_$JUSTIFY("",13)_"IF BLUE CROSS/BLUE SHIELD IDs ARE NEEDED TO PRINT FOR ANY"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+45 SET Z0="*"_$JUSTIFY("",13)_"OF THESE PLANS, ITS ELECTRONIC PLAN TYPE MUST BE CHANGED TO BL."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:2
+46 ;
+47 IF IBZ=5
Begin DoDot:2
+48 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+49 SET Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD PLAN IS DEFINED FOR THE INSURANCE"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+50 SET Z0="*"_$JUSTIFY("",13)_"COMPANY, BUT YOU HAVE ONLY NON-BLUE CROSS/SHIELD IDS SET UP."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+51 SET Z0="*"_$JUSTIFY("",13)_"YOU MUST SET UP THE APPROPRIATE BLUE CROSS/BLUE SHIELD IDs"
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+52 SET Z0="*"_$JUSTIFY("",13)_"FOR THE INSURANCE COMPANY."
DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:2
+53 ;
+54 IF IBZ=6
Begin DoDot:2
+55 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+56 SET Z0="* SUGGESTION: CHANGE PROVIDER ID TYPE TO UPIN."
+57 DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+58 SET Z0="*"_$JUSTIFY("",13)_"ONCE ALL PAYERS FULLY IMPLEMENT HIPAA EDITS, YOU"
+59 DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
+60 SET Z0="*"_$JUSTIFY("",13)_"MUST USE THE CORRECT ID TYPE FOR THE ID ENTERED."
+61 DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:2
+62 ;
+63 DO WRT(1,"*"_$JUSTIFY("",77)_"*",IBCONT)
+64 SET Z1="*"_$JUSTIFY("",$SELECT(IBZ'=1:13,1:11))_"VISTA OPTION TO USE: "
+65 IF IBZ'=4
Begin DoDot:2
+66 SET Z0=Z1_"PROVIDER ID MAINTENANCE"
End DoDot:2
+67 IF IBZ=4
Begin DoDot:2
+68 SET Z0=Z1_"INSURANCE COMPANY ENTRY/EDIT"
End DoDot:2
+69 DO WRT(1,Z0_$JUSTIFY("",78-$LENGTH(Z0))_"*",IBCONT)
End DoDot:1
+70 ;
+71 DO WRT(1,Z,IBCONT)
+72 ;
+73 IF '$ORDER(^TMP($JOB,"IBZ232",IBZ,0))
DO WRT(2,"***** NOTHING FOUND FOR THIS ERROR/WARNING *****",IBCONT)
+74 QUIT
+75 ;
INSHDR(IBPG,IBSTOP,IBINM,IBZ,IBICONT) ; Ins Co info
+1 IF ($Y+7)>IOSL
DO HDR1(.IBPG,.IBSTOP,IBZ,1)
+2 if IBSTOP
QUIT
+3 DO WRT(2,"INSURANCE CO NAME: "_IBINM_$SELECT($GET(IBICONT):" (Continued)",1:""),IBICONT)
+4 QUIT
+5 ;
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 ;
WRT(FF,TEXT,NOT) ; Wrt/store line
+1 NEW Z,A
+2 SET A=+$ORDER(^TMP($JOB,"SENDMSG",1,""),-1)
SET NOT=$GET(NOT)
+3 IF FF
FOR Z=1:1:FF
WRITE !
IF $GET(^TMP($JOB,"SENDMSG"))
IF 'NOT
IF Z>1
SET A=A+1
SET ^TMP($JOB,"SENDMSG",1,A)=" "
+4 ;
+5 IF TEXT="@IOF"
Begin DoDot:1
+6 WRITE @IOF
+7 IF $GET(^TMP($JOB,"SENDMSG"))
IF 'NOT
IF IBPG>1
Begin DoDot:2
+8 SET A=A+1
SET ^TMP($JOB,"SENDMSG",1,A)=" "
+9 FOR Z=1:1:2
SET A=A+1
SET ^TMP($JOB,"SENDMSG",1,A)="*** TOP OF NEW PAGE ***"
+10 SET A=A+1
SET ^TMP($JOB,"SENDMSG",1,A)=" "
End DoDot:2
End DoDot:1
QUIT
+11 ;
+12 WRITE TEXT
+13 IF $GET(^TMP($JOB,"SENDMSG"))
IF 'NOT
SET A=A+1
SET ^TMP($JOB,"SENDMSG",1,A)=TEXT
+14 QUIT
+15 ;
