Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEQ1A

IBCEQ1A.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. RPTOUT ; Print from data in ^XTMP
  1.  N IBP,IBA,IBI,IBIN,IBPNM,IBPNUM,IBSTOP,IBX,IBZ,IBPG,IBICONT,Z
  1.  K ^TMP($J,"IBZ232")
  1.  F Z=1:1:6 S ^TMP($J,"IBZ232",Z)=""
  1.  S (IBPG,IBSTOP)=0
  1.  S IBA=0 F  S IBA=$O(^XTMP("IB_PLAN232",1,IBA)) Q:'IBA  D
  1.  . S IBX=$G(^XTMP("IB_PLAN232",1,IBA,0))
  1.  . ; Sort by err type, ins co ien
  1.  . S ^TMP($J,"IBZ232",+$P(IBX,U,16),+$P(IBX,U,11),IBA)=IBX
  1.  ;
  1.  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
  1.  . S IBIN=$P($G(^DIC(36,+IBI,0)),U)_" ("_$S(+$G(^(3))=1:"",1:"NOT ")_"SET TO TRANSMIT LIVE)"
  1.  . D INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,0) S IBICONT=0
  1.  . S IBA=0 F  S IBA=$O(^TMP($J,"IBZ232",IBZ,IBI,IBA)) Q:'IBA!IBSTOP  S IBX=$G(^(IBA)) D
  1.  .. I ($Y+5)>IOSL D INSHDR(.IBPG,.IBSTOP,IBIN,IBZ,IBICONT) Q:IBSTOP
  1.  .. ;
  1.  .. I IBZ'=4,IBZ'=5 D
  1.  ... S IBP=+$P(IBX,U,14)
  1.  ... I $P(IBX,U,14)[".91" S IBPNM="ALL PROVIDERS"
  1.  ... I $P(IBX,U,14)'[".91" D
  1.  .... N Z
  1.  .... S Z=$P($G(^IBA(355.9,IBP,0)),U)
  1.  .... S IBPNM=$S(Z["VA(200":"",1:"#")_$$EXTERNAL^DILFD(355.9,.01,"",Z)
  1.  ... S IBPNUM=$P($G(^IBA(+$P($P(IBX,U,14),";",2),IBP,0)),U,7)
  1.  ... 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))
  1.  .. ;
  1.  .. I IBZ=4!(IBZ=5) D
  1.  ... ;IB*516/TAZ - Change Group Name from piece 3 to field 2.01, and group Number from piece 4 to field 2.02
  1.  ... ;N Z
  1.  ... N GNUM,GNAM,EPTYP
  1.  ... ;S Z=$G(^IBA(355.3,+$P(IBX,U,13),0))
  1.  ... ;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)))
  1.  ... S GNUM=$$GET1^DIQ(355.3,+$P(IBX,U,13)_",",2.02)  ;Group Number
  1.  ... S GNAM=$$GET1^DIQ(355.3,+$P(IBX,U,13)_",",2.01)  ;Group Name
  1.  ... S EPTYP=$$GET1^DIQ(355.3,+$P(IBX,U,13)_",",.15)  ;Electronic Plan Type
  1.  ... D WRT(1,"   "_$E(GNUM_$J("",20),1,20)_"  "_$E(GNAM_$J("",17),1,17)_"  "_EPTYP)
  1.  .. S:'IBICONT IBICONT=1
  1.  ;
  1.  I 'IBSTOP D  ;Totals
  1.  . N Z
  1.  . S Z=$G(^XTMP("IB_PLAN232"))
  1.  . I ($Y+10)>IOSL!'IBPG D HDR(.IBPG,.IBSTOP,"") Q:IBSTOP
  1.  . D WRT(2,$J("",25)_"TOTAL # OF IDs CHECKED: "_+$P(Z,U,4))
  1.  . D WRT(1,$J("",14)_"TOT # BLUE CROSS/SHIELD IDS FOUND: "_+$P(Z,U,5))
  1.  . D WRT(1,"TOTAL # OF INS CO. W/BLUE PLANS AND NO BLUE IDS: "_+$P(Z,U,3))
  1.  . D WRT(1,$J("",21)_"TOTAL # OF ERRORS/WARNINGS: "_+$P(Z,U,6))
  1.  ;
  1.  I '$D(ZTQUEUED) D ^%ZISC I 'IBSTOP,IBPG D ASK()
  1.  I $D(ZTQUEUED),'IBSTOP S ZTREQ="@"
  1.  I $G(^TMP($J,"SENDMSG")),'IBSTOP D
  1.  . N XMDUZ,XMSUBJ,XMBODY,XMTO,XMZ
  1.  . 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)"
  1.  . M XMTO=^TMP($J,"SENDMSG",0)
  1.  . S Z="" F  S Z=$O(^TMP($J,"SENDMSG",0,Z)) Q:Z=""  S XMZ(Z)=""
  1.  . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,"",.XMZ)
  1.  K ^TMP($J,"IBZ232"),^TMP($J,"SENDMSG")
  1.  Q
  1.  ;
  1. HDR(IBPG,IBSTOP,IBZ,FF) ; Main hdr
  1.  ; FF = 0 if continuation pg so it writes it to report, but not mail msg
  1.  N Z,IBT
  1.  Q:$G(IBSTOP)
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S (IBSTOP,ZTSTOP)=1 K ZTREQ I +$G(IBPG) D WRT(2,"***TASK STOPPED BY USER***") Q
  1.  I IBPG&($E(IOST,1,2)="C-") D ASK(.IBSTOP) Q:IBSTOP
  1.  S IBT=$S(IBPG:1,1:0)
  1.  S IBPG=IBPG+1
  1.  S Z="PROVIDER ID VERIFICATION QUERY REPORT"
  1.  S Z=$$SETSTR^VALM1($J("",80-$L(Z)\2)_Z,"",1,79)
  1.  S Z=$$SETSTR^VALM1("Page: "_IBPG,Z,70,10)
  1.  D WRT(0,"@IOF",$G(FF))
  1.  D WRT(1,Z,$G(FF))
  1.  S Z="RUN DATE: "_$$FMTE^XLFDT(DT,2),Z=$J("",80-$L(Z)\2)_Z
  1.  D WRT(1,Z,$G(FF))
  1.  I IBZ'="",IBZ'=4,IBZ'=5 D
  1.  . D WRT(2,"   FORM TYPE  PROV ID TYPE"_$J("",12)_"PROVIDER NAME (#=Non-VA)"_$J("",6)_"PROV ID",$G(FF))
  1.  I IBZ=4!(IBZ=5) D
  1.  . D WRT(2,"   GROUP NAME"_$J("",12)_"GROUP NUMBER"_$J("",7)_"ELECTRONIC PLAN TYPE",$G(FF))
  1.  D WRT(1,$TR($J("",IOM-1)," ","-"),$G(FF))
  1.  Q
  1.  ;
  1. HDR1(IBPG,IBSTOP,IBZ,IBCONT) ; Hdr err typ
  1.  N Z,Z0,Z1
  1.  D HDR(.IBPG,.IBSTOP,IBZ,IBCONT) Q:IBSTOP
  1.  S Z="",$P(Z,"*",80)="" D WRT(1,Z,IBCONT)
  1.  S Z0="* "_$S(IBZ>1:"WARNING: ",1:"ERROR: ")
  1.  ;
  1.  I IBZ'=4,IBZ'=5 D
  1.  . N X
  1.  . 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"
  1.  . 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:"")
  1.  I IBZ=4 D
  1.  . S Z0=Z0_"BL CROSS/BL SHIELD IDs FOUND FOR PLANS NOT HAVING 'BL' ELECTRONIC" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  . S Z0="*"_$J("",10)_"PLAN TYPE"
  1.  ;
  1.  I IBZ=5 D
  1.  . S Z0=Z0_"INSURANCE CO HAS BL CROSS/SHIELD PLANS, BUT NO BL CROSS/SHIELD IDs"
  1.  ;
  1.  S Z0=Z0_$S(IBCONT:" (CONT)",1:"")
  1.  D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  ;
  1.  I 'IBCONT D
  1.  . I IBZ=1 D
  1.  .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  .. S Z0="* SOLUTION: THIS ID WILL NEVER BE USED ELECTRONICALLY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. 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)
  1.  .. S Z0="*"_$J("",11)_"TRANSMITTED ON A 1500." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  . ;
  1.  . I IBZ=2 D
  1.  .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  .. S Z0="* SUGGESTION: VISTA WILL TRANSMIT THIS ID ELECTRONICALLY, BUT IT IS OPTIMAL"  D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. S Z0="*"_$J("",13)_"TO HAVE THIS ID SET UP AS BLUE CROSS." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  . ;
  1.  . I IBZ=3 D
  1.  .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  .. 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)
  1.  .. 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)
  1.  .. 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)
  1.  .. S Z0="*"_$J("",13)_"APPLIED TO A CMS-1500 FORM TYPE." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  . ;
  1.  . I IBZ=4 D
  1.  .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  .. S Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD ID IS DEFINED FOR THE INSURANCE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. 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)
  1.  .. 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)
  1.  .. 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)
  1.  .. 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)
  1.  . ;
  1.  . I IBZ=5 D
  1.  .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  .. S Z0="* SUGGESTION: A BLUE CROSS OR BLUE SHIELD PLAN IS DEFINED FOR THE INSURANCE" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. 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)
  1.  .. S Z0="*"_$J("",13)_"YOU MUST SET UP THE APPROPRIATE BLUE CROSS/BLUE SHIELD IDs" D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. S Z0="*"_$J("",13)_"FOR THE INSURANCE COMPANY." D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  . ;
  1.  . I IBZ=6 D
  1.  .. D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  .. S Z0="* SUGGESTION: CHANGE PROVIDER ID TYPE TO UPIN."
  1.  .. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. S Z0="*"_$J("",13)_"ONCE ALL PAYERS FULLY IMPLEMENT HIPAA EDITS, YOU"
  1.  .. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  .. S Z0="*"_$J("",13)_"MUST USE THE CORRECT ID TYPE FOR THE ID ENTERED."
  1.  .. D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  . ;
  1.  . D WRT(1,"*"_$J("",77)_"*",IBCONT)
  1.  . S Z1="*"_$J("",$S(IBZ'=1:13,1:11))_"VISTA OPTION TO USE: "
  1.  . I IBZ'=4 D
  1.  .. S Z0=Z1_"PROVIDER ID MAINTENANCE"
  1.  . I IBZ=4 D
  1.  .. S Z0=Z1_"INSURANCE COMPANY ENTRY/EDIT"
  1.  . D WRT(1,Z0_$J("",78-$L(Z0))_"*",IBCONT)
  1.  ;
  1.  D WRT(1,Z,IBCONT)
  1.  ;
  1.  I '$O(^TMP($J,"IBZ232",IBZ,0)) D WRT(2,"***** NOTHING FOUND FOR THIS ERROR/WARNING *****",IBCONT)
  1.  Q
  1.  ;
  1. INSHDR(IBPG,IBSTOP,IBINM,IBZ,IBICONT) ; Ins Co info
  1.  I ($Y+7)>IOSL D HDR1(.IBPG,.IBSTOP,IBZ,1)
  1.  Q:IBSTOP
  1.  D WRT(2,"INSURANCE CO NAME: "_IBINM_$S($G(IBICONT):" (Continued)",1:""),IBICONT)
  1.  Q
  1.  ;
  1. ASK(IBSTOP) ; Ask continue
  1.  ; If passed by ref, IBSTOP returned = 1 if print aborted
  1.  I $E(IOST,1,2)'["C-" Q
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="E" W ! D ^DIR
  1.  I ($D(DIRUT))!($D(DUOUT)) S IBSTOP=1 Q
  1.  Q
  1.  ;
  1. WRT(FF,TEXT,NOT) ; Wrt/store line
  1.  N Z,A
  1.  S A=+$O(^TMP($J,"SENDMSG",1,""),-1),NOT=$G(NOT)
  1.  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)=" "
  1.  ;
  1.  I TEXT="@IOF" D  Q
  1.  . W @IOF
  1.  . I $G(^TMP($J,"SENDMSG")),'NOT,IBPG>1 D
  1.  .. S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
  1.  .. F Z=1:1:2 S A=A+1,^TMP($J,"SENDMSG",1,A)="*** TOP OF NEW PAGE ***"
  1.  .. S A=A+1,^TMP($J,"SENDMSG",1,A)=" "
  1.  ;
  1.  W TEXT
  1.  I $G(^TMP($J,"SENDMSG")),'NOT S A=A+1,^TMP($J,"SENDMSG",1,A)=TEXT
  1.  Q
  1.  ;