IBCNSJ14 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN (CON'T) ; 07-MAR-95
;;2.0;INTEGRATED BILLING;**28,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
SEL ; Select a company and plan.
; Required variable input:
; IBCNS -- Pointer to the current company in file #36
; Variable output:
; IBPLAN -- Pointer to the selected plan in file #355.3
; IBQUIT -- Set to 1 if user wants to quit.
;
; - does the user want to switch companies?
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Inactivate another plan offered by the same company",DIR("?")="To inactivate another plan from this company, answer 'YES.' To switch companies, answer 'NO.'"
D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 G SELQ
;
SEL4 ; - this entry point is supported for a call from IBCNSJ4.
; Input: IBINACTM -- [optional]: set to 1 if entry is from
; IBCNSJ4 (the multiple plan inactivator).
; If entry is from IBCNSJ4, inactive plans
; may not be selected.
; Y -- must be set to 0 when called by IBCNSJ4.
;
I 'Y D I IBQUIT G SELQ
.S DIC(0)="QEAMZ",DIC="^DIC(36,",DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1)"
.S DIC("A")="Select PLAN COMPANY: "
.D ^DIC K DIC S IBCNS=+Y I Y<0 S IBQUIT=1
;
; - see if user wants to directly select the plan
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to directly enter this plan"
S DIR("?")="The look-up facility to select "_$S($G(IBINACTM):"an active",1:"a")_" group plan has been enhanced to use the List Manager. Enter 'NO' if you wish to select a plan from this look-up, or 'YES' to directly enter the plan."
D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 G SELQ
;
; - invoke the plan look-up
I 'Y D G SELQ
.W " ..." S IBPLAN=0 D LKP^IBCNSU2(IBCNS,0,0,.IBPLAN,0,'$G(IBINACTM))
.I 'IBPLAN W !!,"No plan selected!",! S IBQUIT=1
;
; - allow a FileMan look-up
; MRD;IB*2.0*516 - Display new Group Name and Number fields.
S DIC("A")="Select "_$S($G(IBINACTM):"an Active",1:"a")_" GROUP PLAN: "
S DIC="^IBA(355.3,",DIC(0)="AEQM",DIC("S")="I +^(0)=IBCNS,$P(^(0),U,2)"
;S DIC("W")="N IBX S IBX=$G(^(0)) W "" Name: "",$E($S($P(IBX,U,3)]"""":$P(IBX,U,3),1:""<none>"")_$J("""",20),1,20),"" Number: "",$S($P(IBX,U,4)]"""":$P(IBX,U,4),1:""<none>"")"
S DIC("W")="N IBX S IBX=$G(^(2)) W "" Name: "",$E($S($P(IBX,U,1)]"""":$P(IBX,U,1),1:""<none>"")_$J("""",20),1,20),"" Number: "",$E($S($P(IBX,U,2)]"""":$P(IBX,U,2),1:""<none>""),1,14)"
I $G(IBINACTM) S DIC("S")=DIC("S")_",'$P(^(0),U,11)"
D ^DIC K DIC S IBPLAN=+Y I Y<0 S IBQUIT=1
;
SELQ K DIRUT,DUOUT,DTOUT,DIROUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSJ14 2707 printed Oct 16, 2024@18:17:56 Page 2
IBCNSJ14 ;ALB/CPM - INACTIVATE AN INSURANCE PLAN (CON'T) ; 07-MAR-95
+1 ;;2.0;INTEGRATED BILLING;**28,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
SEL ; Select a company and plan.
+1 ; Required variable input:
+2 ; IBCNS -- Pointer to the current company in file #36
+3 ; Variable output:
+4 ; IBPLAN -- Pointer to the selected plan in file #355.3
+5 ; IBQUIT -- Set to 1 if user wants to quit.
+6 ;
+7 ; - does the user want to switch companies?
+8 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Inactivate another plan offered by the same company"
SET DIR("?")="To inactivate another plan from this company, answer 'YES.' To switch companies, answer 'NO.'"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBQUIT=1
GOTO SELQ
+10 ;
SEL4 ; - this entry point is supported for a call from IBCNSJ4.
+1 ; Input: IBINACTM -- [optional]: set to 1 if entry is from
+2 ; IBCNSJ4 (the multiple plan inactivator).
+3 ; If entry is from IBCNSJ4, inactive plans
+4 ; may not be selected.
+5 ; Y -- must be set to 0 when called by IBCNSJ4.
+6 ;
+7 IF 'Y
Begin DoDot:1
+8 SET DIC(0)="QEAMZ"
SET DIC="^DIC(36,"
SET DIC("S")="I $$ANYGP^IBCNSJ(+Y,0,1)"
+9 SET DIC("A")="Select PLAN COMPANY: "
+10 DO ^DIC
KILL DIC
SET IBCNS=+Y
IF Y<0
SET IBQUIT=1
End DoDot:1
IF IBQUIT
GOTO SELQ
+11 ;
+12 ; - see if user wants to directly select the plan
+13 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you wish to directly enter this plan"
+14 SET DIR("?")="The look-up facility to select "_$SELECT($GET(IBINACTM):"an active",1:"a")_" group plan has been enhanced to use the List Manager. Enter 'NO' if you wish to select a plan from this look-up, or 'YES' to directly enter the plan."
+15 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET IBQUIT=1
GOTO SELQ
+16 ;
+17 ; - invoke the plan look-up
+18 IF 'Y
Begin DoDot:1
+19 WRITE " ..."
SET IBPLAN=0
DO LKP^IBCNSU2(IBCNS,0,0,.IBPLAN,0,'$GET(IBINACTM))
+20 IF 'IBPLAN
WRITE !!,"No plan selected!",!
SET IBQUIT=1
End DoDot:1
GOTO SELQ
+21 ;
+22 ; - allow a FileMan look-up
+23 ; MRD;IB*2.0*516 - Display new Group Name and Number fields.
+24 SET DIC("A")="Select "_$SELECT($GET(IBINACTM):"an Active",1:"a")_" GROUP PLAN: "
+25 SET DIC="^IBA(355.3,"
SET DIC(0)="AEQM"
SET DIC("S")="I +^(0)=IBCNS,$P(^(0),U,2)"
+26 ;S DIC("W")="N IBX S IBX=$G(^(0)) W "" Name: "",$E($S($P(IBX,U,3)]"""":$P(IBX,U,3),1:""<none>"")_$J("""",20),1,20),"" Number: "",$S($P(IBX,U,4)]"""":$P(IBX,U,4),1:""<none>"")"
+27 SET DIC("W")="N IBX S IBX=$G(^(2)) W "" Name: "",$E($S($P(IBX,U,1)]"""":$P(IBX,U,1),1:""<none>"")_$J("""",20),1,20),"" Number: "",$E($S($P(IBX,U,2)]"""":$P(IBX,U,2),1:""<none>""),1,14)"
+28 IF $GET(IBINACTM)
SET DIC("S")=DIC("S")_",'$P(^(0),U,11)"
+29 DO ^DIC
KILL DIC
SET IBPLAN=+Y
IF Y<0
SET IBQUIT=1
+30 ;
SELQ KILL DIRUT,DUOUT,DTOUT,DIROUT
+1 QUIT
