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

IBCEPC.m

Go to the documentation of this file.
  1. IBCEPC ;ALB/WCJ - Insurance company plan type list ;22-DEC-2005
  1. ;;2.0;INTEGRATED BILLING;**320,348**;21-MAR-94;Build 5
  1. EN ; -- main entry point for IBCE INSCO BILL PROV MAINT
  1. D EN^VALM("IBCE INSCO BILL PROV MAINT")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N PCF,PCDISP
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. S PCF=$P($G(^DIC(36,+IBCNS,3)),U,13),PCDISP=$S(PCF="P":"(Parent)",1:"")
  1. S VALMHDR(1)="Insurance Co: "_$P($G(^DIC(36,+IBCNS,0)),U)_PCDISP
  1. Q
  1. ;
  1. INIT ; Initialize
  1. N IBLCT,IBCT
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. S (IBCT,IBLCT)=0
  1. ; Display the list
  1. D SET1(.IBLCT,"Transmit no billing Provider Sec ID for the following Electronic Plan Types:",IBCT+1)
  1. D LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
  1. F IBCT=1:1:+$G(TAR("DILIST",0)) D
  1. . D SET1(.IBLCT,IBCT_" "_TAR("DILIST",1,IBCT),IBCT)
  1. . S ^TMP("IBCE INSCO BILL PROV MAINT",$J,"ZIDX",IBCT)=TAR("DILIST",2,IBCT)_U_TAR("DILIST",1,IBCT)
  1. S VALMBG=1,VALMCNT=IBLCT
  1. Q
  1. ;
  1. SET1(IBLCT,TEXT,IBCT) ;
  1. S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT,$G(IBCT))
  1. Q
  1. ;
  1. EXPND ;
  1. Q
  1. HELP ;
  1. Q
  1. EXIT ;
  1. D CLEAN^VALM10
  1. Q
  1. ADD ;
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. N DIR,X,Y,DIC,DA
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. S DIR("A")="Plan Type: ",DIR(0)="36.013,.01AOr"
  1. D ^DIR K DIR
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. ;
  1. S X=Y
  1. S DIC(0)="L",DA(1)=IBCNS
  1. S DIC="^DIC(36,"_DA(1)_",13,"
  1. D ^DIC
  1. K ^TMP("IBCE INSCO BILL PROV MAINT",$J)
  1. D INIT
  1. ;
  1. Q
  1. DEL ;
  1. S VALMBCK="R"
  1. I '$D(^TMP("IBCE INSCO BILL PROV MAINT",$J,"ZIDX")) Q ;nothing to delete
  1. N IBDA
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. D SEL
  1. Q:'$G(IBDA)
  1. N DA,DIK,X,Y
  1. S DA=+IBDA,DA(1)=IBCNS
  1. S DIK="^DIC(36,"_IBCNS_",13,"
  1. D ^DIK
  1. K ^TMP("IBCE INSCO BILL PROV MAINT",$J)
  1. D INIT
  1. Q
  1. ;
  1. SEL ;
  1. N Z
  1. K IBDA
  1. D FULL^VALM1
  1. D EN^VALM2($G(XQORNOD(0)),"OS")
  1. S Z=+$O(VALMY(0)) Q:'Z
  1. ; fac/ins co default
  1. S IBDA=$G(^TMP("IBCE INSCO BILL PROV MAINT",$J,"ZIDX",Z))
  1. Q