IBCEPC ;ALB/WCJ - Insurance company plan type list ;22-DEC-2005
;;2.0;INTEGRATED BILLING;**320,348**;21-MAR-94;Build 5
EN ; -- main entry point for IBCE INSCO BILL PROV MAINT
D EN^VALM("IBCE INSCO BILL PROV MAINT")
Q
;
HDR ; -- header code
N PCF,PCDISP
I '$D(IBCNS) N IBCNS S IBCNS=IBINS
S PCF=$P($G(^DIC(36,+IBCNS,3)),U,13),PCDISP=$S(PCF="P":"(Parent)",1:"")
S VALMHDR(1)="Insurance Co: "_$P($G(^DIC(36,+IBCNS,0)),U)_PCDISP
Q
;
INIT ; Initialize
N IBLCT,IBCT
I '$D(IBCNS) N IBCNS S IBCNS=IBINS
S (IBCT,IBLCT)=0
; Display the list
D SET1(.IBLCT,"Transmit no billing Provider Sec ID for the following Electronic Plan Types:",IBCT+1)
D LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
F IBCT=1:1:+$G(TAR("DILIST",0)) D
. D SET1(.IBLCT,IBCT_" "_TAR("DILIST",1,IBCT),IBCT)
. S ^TMP("IBCE INSCO BILL PROV MAINT",$J,"ZIDX",IBCT)=TAR("DILIST",2,IBCT)_U_TAR("DILIST",1,IBCT)
S VALMBG=1,VALMCNT=IBLCT
Q
;
SET1(IBLCT,TEXT,IBCT) ;
S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT,$G(IBCT))
Q
;
EXPND ;
Q
HELP ;
Q
EXIT ;
D CLEAN^VALM10
Q
ADD ;
D FULL^VALM1
S VALMBCK="R"
N DIR,X,Y,DIC,DA
I '$D(IBCNS) N IBCNS S IBCNS=IBINS
S DIR("A")="Plan Type: ",DIR(0)="36.013,.01AOr"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
;
S X=Y
S DIC(0)="L",DA(1)=IBCNS
S DIC="^DIC(36,"_DA(1)_",13,"
D ^DIC
K ^TMP("IBCE INSCO BILL PROV MAINT",$J)
D INIT
;
Q
DEL ;
S VALMBCK="R"
I '$D(^TMP("IBCE INSCO BILL PROV MAINT",$J,"ZIDX")) Q ;nothing to delete
N IBDA
I '$D(IBCNS) N IBCNS S IBCNS=IBINS
D SEL
Q:'$G(IBDA)
N DA,DIK,X,Y
S DA=+IBDA,DA(1)=IBCNS
S DIK="^DIC(36,"_IBCNS_",13,"
D ^DIK
K ^TMP("IBCE INSCO BILL PROV MAINT",$J)
D INIT
Q
;
SEL ;
N Z
K IBDA
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),"OS")
S Z=+$O(VALMY(0)) Q:'Z
; fac/ins co default
S IBDA=$G(^TMP("IBCE INSCO BILL PROV MAINT",$J,"ZIDX",Z))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPC 1908 printed Apr 09, 2024@21:21:35 Page 2
IBCEPC ;ALB/WCJ - Insurance company plan type list ;22-DEC-2005
+1 ;;2.0;INTEGRATED BILLING;**320,348**;21-MAR-94;Build 5
EN ; -- main entry point for IBCE INSCO BILL PROV MAINT
+1 DO EN^VALM("IBCE INSCO BILL PROV MAINT")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW PCF,PCDISP
+2 IF '$DATA(IBCNS)
NEW IBCNS
SET IBCNS=IBINS
+3 SET PCF=$PIECE($GET(^DIC(36,+IBCNS,3)),U,13)
SET PCDISP=$SELECT(PCF="P":"(Parent)",1:"")
+4 SET VALMHDR(1)="Insurance Co: "_$PIECE($GET(^DIC(36,+IBCNS,0)),U)_PCDISP
+5 QUIT
+6 ;
INIT ; Initialize
+1 NEW IBLCT,IBCT
+2 IF '$DATA(IBCNS)
NEW IBCNS
SET IBCNS=IBINS
+3 SET (IBCT,IBLCT)=0
+4 ; Display the list
+5 DO SET1(.IBLCT,"Transmit no billing Provider Sec ID for the following Electronic Plan Types:",IBCT+1)
+6 DO LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
+7 FOR IBCT=1:1:+$GET(TAR("DILIST",0))
Begin DoDot:1
+8 DO SET1(.IBLCT,IBCT_" "_TAR("DILIST",1,IBCT),IBCT)
+9 SET ^TMP("IBCE INSCO BILL PROV MAINT",$JOB,"ZIDX",IBCT)=TAR("DILIST",2,IBCT)_U_TAR("DILIST",1,IBCT)
End DoDot:1
+10 SET VALMBG=1
SET VALMCNT=IBLCT
+11 QUIT
+12 ;
SET1(IBLCT,TEXT,IBCT) ;
+1 SET IBLCT=IBLCT+1
DO SET^VALM10(IBLCT,TEXT,$GET(IBCT))
+2 QUIT
+3 ;
EXPND ;
+1 QUIT
HELP ;
+1 QUIT
EXIT ;
+1 DO CLEAN^VALM10
+2 QUIT
ADD ;
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW DIR,X,Y,DIC,DA
+4 IF '$DATA(IBCNS)
NEW IBCNS
SET IBCNS=IBINS
+5 SET DIR("A")="Plan Type: "
SET DIR(0)="36.013,.01AOr"
+6 DO ^DIR
KILL DIR
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+8 ;
+9 SET X=Y
+10 SET DIC(0)="L"
SET DA(1)=IBCNS
+11 SET DIC="^DIC(36,"_DA(1)_",13,"
+12 DO ^DIC
+13 KILL ^TMP("IBCE INSCO BILL PROV MAINT",$JOB)
+14 DO INIT
+15 ;
+16 QUIT
DEL ;
+1 SET VALMBCK="R"
+2 ;nothing to delete
IF '$DATA(^TMP("IBCE INSCO BILL PROV MAINT",$JOB,"ZIDX"))
QUIT
+3 NEW IBDA
+4 IF '$DATA(IBCNS)
NEW IBCNS
SET IBCNS=IBINS
+5 DO SEL
+6 if '$GET(IBDA)
QUIT
+7 NEW DA,DIK,X,Y
+8 SET DA=+IBDA
SET DA(1)=IBCNS
+9 SET DIK="^DIC(36,"_IBCNS_",13,"
+10 DO ^DIK
+11 KILL ^TMP("IBCE INSCO BILL PROV MAINT",$JOB)
+12 DO INIT
+13 QUIT
+14 ;
SEL ;
+1 NEW Z
+2 KILL IBDA
+3 DO FULL^VALM1
+4 DO EN^VALM2($GET(XQORNOD(0)),"OS")
+5 SET Z=+$ORDER(VALMY(0))
if 'Z
QUIT
+6 ; fac/ins co default
+7 SET IBDA=$GET(^TMP("IBCE INSCO BILL PROV MAINT",$JOB,"ZIDX",Z))
+8 QUIT
