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

IBCEP.m

Go to the documentation of this file.
  1. IBCEP ;ALB/TMP - Functions for PROVIDER ID MAINT - INS CO PARAMS ;11-02-00
  1. ;;2.0;INTEGRATED BILLING;**137,232,320,348,349,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for IBCE PRV INS PARAMS
  1. N IBINS,IBCUINC ; Variable should be available throughout actions
  1. D FULL^VALM1
  1. D EN^VALM("IBCE PRV INS PARAMS")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. K VALMHDR
  1. I $G(IBINS) S VALMHDR(1)="INSURANCE CO: "_$P($G(^DIC(36,+IBINS,0)),U)
  1. Q
  1. ;
  1. INIT ; Initialization
  1. N DIR,DIC,DA,X,Y,DTOUT,DUOUT
  1. S DIC(0)="AEMQ",DIC="^DIC(36," D ^DIC
  1. I Y'>0 D
  1. . S VALMQUIT=1
  1. E D
  1. . S DIR="YA",DIR("A")="DO YOU WANT TO INCLUDE ANY CARE UNIT DETAIL?: ",DIR("?",1)="If you want to see the specific care unit defined for the insurance co",DIR("?")="you should respond yes here"
  1. . W ! D ^DIR K DIR W !
  1. . I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 Q
  1. . S IBCUINC=(Y=1)
  1. . S IBINS=+Y D BLD(IBINS,IBCUINC)
  1. Q
  1. ;
  1. BLD(IBINS,IBCUINC) ; Build display for ins co level provider ID parameters
  1. ; IBINS = ien of ins co (file 36)
  1. ; IBCUINC = flag:
  1. ; = 1 if care unit list should be included or 0 if not
  1. N A,A0,A1,A2,A3,Z0,IB1,IB12,IB4,IBLCT,IBPTYP
  1. S IBLCT=0
  1. S IB4=$G(^DIC(36,IBINS,4))
  1. K ^TMP("IBPRV_INS_ID_PARAMS",$J)
  1. ;
  1. S Z0="Perf Prov Secondary ID Type (1500): "_$E($$EXPAND^IBTRE(36,4.01,+$P(IB4,U))_$J("",20),1,20) D SET1(.IBLCT,Z0)
  1. S Z0="Perf Prov Secondary ID Type (UB04): "_$E($$EXPAND^IBTRE(36,4.02,+$P(IB4,U,2))_$J("",20),1,20) D SET1(.IBLCT,Z0)
  1. S Z0=$J("",20)_"Required: "_$$EXPAND^IBTRE(36,4.03,$P(IB4,U,3)) D SET1(.IBLCT,Z0)
  1. S Z0=$J("",10)_"Care Unit Name: "_$$EXPAND^IBTRE(36,4.09,$P(IB4,U,9)) D SET1(.IBLCT,Z0)
  1. S Z0="" D SET1(.IBLCT,Z0)
  1. ;
  1. I '$D(^IBA(355.96,"D",IBINS)) D G BLDQ ;No care unit needed
  1. . S Z0=$J("",7)_"*** NO CARE UNITS DEFINED FOR THIS INS CO PROVIDER SECONDARY ID ***" D SET1(.IBLCT,Z0)
  1. ;
  1. S Z0=$J("",17)_"VALID CARE UNITS FOR THIS INSURANCE COMPANY" D SET1(.IBLCT,Z0),CNTRL^VALM10(IBLCT,18,46,IORVON,IORVOFF)
  1. S A=0
  1. F S A=$O(^IBA(355.96,"AC",IBINS,A)) Q:'A S IBPTYP=$P($G(^IBE(355.97,A,0)),U) I IBPTYP'="" D
  1. . S A2=IBPTYP_U_A,^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A2)=""
  1. . S A0=0 F S A0=$O(^IBA(355.96,"AC",IBINS,A,A0)) Q:'A0 S A1=$G(^IBA(355.96,A0,0)) D
  1. .. I '$G(IBCUINC) S:'$D(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A2,$P(A1,U,4)_U_$P(A1,U,5))) ^($P(A1,U,4)_U_$P(A1,U,5))="" Q
  1. .. I $P(A1,U,4)'="",$P(A1,U,5)'="" D
  1. ... S A3=$E($P($G(^IBE(355.95,+A1,0)),U)_$J("",1,30),1,30)_U_$S($P($G(^(0)),U,2)'="":$P(^(0),U,2),1:"<No description available>")
  1. ... I '$D(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A2,$P(A1,U,4)_U_$P(A1,U,5),$P(A3,U))) S ^($P(A3,U))=$P(A3,U,2)
  1. . ; records are fully sorted
  1. S A=""
  1. F S A=$O(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A)) Q:'A S A2="PROVIDER ID TYPE: "_$P(A,U),IB1=1 D:'IB1 SET1(.IBLCT,"") D SET1(.IBLCT,A2) S IB12=1 S:$G(IBCUINC) IB1=0 D
  1. . S A0="" F S A0=$O(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A,A0)) Q:A0="" D
  1. .. S Z0=$J("",5)_"FORM TYPE: "_$E($$EXPAND^IBTRE(355.96,.04,$P(A0,U))_$J("",25),1,25)_" CARE TYPE: "_$E($$EXPAND^IBTRE(355.96,.05,$P(A0,U,2))_$J("",25),1,25)
  1. .. D:'IB12 SET1(.IBLCT,"") D SET1(.IBLCT,Z0)
  1. .. Q:'$G(IBCUINC)
  1. .. S IB12=0
  1. .. S A1="" F S A1=$O(^TMP("IBPRV_INS_ID_PARAMS_SORT",$J,A,A0,A1)) Q:A1="" S Z0=$J("",10)_A1_$G(^(A1)) D SET1(.IBLCT,Z0)
  1. ;
  1. BLDQ K ^TMP("IBPRV_INS_ID_PARAMS_SORT",$J)
  1. S VALMCNT=IBLCT,VALMBG=1
  1. Q
  1. ;
  1. SET1(IBLCT,Z0) ;
  1. S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,Z0)
  1. Q
  1. ;
  1. EXPND ;
  1. Q
  1. ;
  1. HELP ;
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("IBPRV_INS_ID_PARAMS",$J)
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. EDIT ; Entrypoint called from IBCSCE to invoke provider id edit functions
  1. Q
  1. ;
  1. EDIT1 ; Edit parameters
  1. N IB,IBY,IBCNS,DIE,DR,X,Y
  1. D FULL^VALM1
  1. S IBCNS=IBINS,IBY=12
  1. D MAIN^IBCNSC1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. NETID() ; Returns the ien of the entry in file 355.97 that is designated as the
  1. ; NETWORK ID
  1. N Z S Z=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z Q:$P($G(^(Z,1)),U,6)
  1. Q Z
  1. ;
  1. EMCID() ; Returns the ien of the entry in file 355.97 that is designated as the
  1. ; EMC ID
  1. N Z S Z=0 F S Z=$O(^IBE(355.97,Z)) Q:'Z Q:$P($G(^(Z,1)),U,5)
  1. Q Z
  1. ;
  1. UPIN() ; Returns the ien of the entry in file 355.97 that is designated as the
  1. ; UPIN ID
  1. Q +$O(^IBE(355.97,"B","UPIN",0))
  1. ;
  1. EDITID(IBCNS) ; Edit provider id's from insurance co enter/edit
  1. ; IBCNS = ien of file 36
  1. Q ; WCJ 12/30/2005
  1. N X,Y,Z4,DIR
  1. S Z4=$G(^DIC(36,IBCNS,4))
  1. I 'Z4,'$P(Z4,U,2) Q
  1. S DIR("A",1)="USE PROVIDER ID MAINTENANCE TO ENTER/EDIT PROV SECONDARY ID'S FOR THIS CO.",DIR("A")="PRESS RETURN TO CONTINUE: ",DIR(0)="EA" W ! D ^DIR K DIR
  1. Q
  1. ;