- 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 Mar 13, 2025@21:22:15 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
