- 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 Feb 18, 2025@23:38:23 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