| 1 | IBCNSJ3 ;ALB/CPM - ADD NEW INSURANCE PLAN ; 11-JAN-95
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | NEW(IBCNS,IBCPOL,IBFG) ; Add a new insurance plan
|
|---|
| 6 | ; Input: IBCNS -- Pointer to an insurance company in file #36
|
|---|
| 7 | ; IBFG -- [Optional] -> Set to 1 to force creation
|
|---|
| 8 | ; of a group plan
|
|---|
| 9 | ; Output: IBCPOL -- 0, if a new plan was not added, or
|
|---|
| 10 | ; >0 => pointer to the new plan in file #355.3
|
|---|
| 11 | ;
|
|---|
| 12 | N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,IBTL,IBGRP,IBGNA,IBGNU,X,Y
|
|---|
| 13 | S IBCPOL=0
|
|---|
| 14 | I '$G(IBCNS) G NEWQ
|
|---|
| 15 | ;
|
|---|
| 16 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to add a new Insurance Plan"
|
|---|
| 17 | S DIR("?")="If you have identified a new plan that has not been previously entered, and you wish to add it, answer 'YES'. If you do not wish to add a new plan, enter 'NO'."
|
|---|
| 18 | D ^DIR K DIR I Y<1!($D(DIRUT)) G NEWQ
|
|---|
| 19 | ;
|
|---|
| 20 | ; - collect plan characteristics
|
|---|
| 21 | I $G(IBFG) S IBGRP=1 G MORE
|
|---|
| 22 | S DIR(0)="355.3,.02",DIR("A")=" IS THIS A GROUP PLAN" D ^DIR K DIR S IBGRP=Y
|
|---|
| 23 | I $D(DIRUT) G NEWQ
|
|---|
| 24 | ;
|
|---|
| 25 | MORE S IBTL=" "_$S(IBGRP:"GROUP",1:"INDIVIDUAL")_" PLAN "
|
|---|
| 26 | S DIR(0)="355.3,.03",DIR("A")=IBTL_"NAME" D ^DIR K DIR G NEWQ:$D(DUOUT)!$D(DTOUT) S IBGNA=Y
|
|---|
| 27 | S DIR(0)="355.3,.04",DIR("A")=IBTL_"NUMBER" D ^DIR K DIR G NEWQ:$D(DUOUT)!$D(DTOUT) S IBGNU=Y
|
|---|
| 28 | ;
|
|---|
| 29 | ; - check for duplicates and file the plan
|
|---|
| 30 | I $$CHECK(IBCNS,IBGNA,IBGNU) S IBCPOL=$$ADDH^IBCNSU(IBCNS,IBGRP,IBGNA,IBGNU)
|
|---|
| 31 | NEWQ Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | CHECK(IBCNS,IBGNA,IBGNU) ; Check for potential duplicate plans
|
|---|
| 35 | ; Input: IBCNS -- Pointer to an insurance company in file #36
|
|---|
| 36 | ; IBGNA -- Plan Name for potential new plan
|
|---|
| 37 | ; IBGNU -- Plan Number for potential new plan
|
|---|
| 38 | ; Output: IBANS -- 1 -> Okay to add the new plan
|
|---|
| 39 | ; 0 -> Don't add the new plan.
|
|---|
| 40 | ;
|
|---|
| 41 | N IBANS,IBCT,IBCNSD
|
|---|
| 42 | S (IBANS,IBCT)=1
|
|---|
| 43 | S IBCNSD=$G(^DIC(36,+$G(IBCNS),0)) I IBCNSD="" G CHECKQ
|
|---|
| 44 | K ^TMP($J,"DUP"),^TMP($J,"DUP1")
|
|---|
| 45 | W !!," Searching for potential duplicate plans offered by ",$E($P(IBCNSD,"^"),1,20),"..."
|
|---|
| 46 | I '$D(^IBA(355.3,"B",IBCNS)) G CHECKQ
|
|---|
| 47 | ;
|
|---|
| 48 | ; - look for potential duplicate plans
|
|---|
| 49 | D:$G(IBGNA)]"" FIND(IBCNS,IBGNA)
|
|---|
| 50 | D:$G(IBGNU)]"" FIND(IBCNS,IBGNU)
|
|---|
| 51 | ;
|
|---|
| 52 | ; - display potential duplicates and see if plan should be filed
|
|---|
| 53 | I $D(^TMP($J,"DUP")) D LIST
|
|---|
| 54 | ;
|
|---|
| 55 | CHECKQ I '$D(^TMP($J,"DUP")) W !!," No potential duplicate plans have been identified."
|
|---|
| 56 | K ^TMP($J,"DUP"),^TMP($J,"DUP1")
|
|---|
| 57 | Q IBANS
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | FIND(IBCNS,IBGN) ; Check cross-references for duplicate plans
|
|---|
| 61 | ; Input: IBCNS -- Pointer to the insurance company in file #36
|
|---|
| 62 | ; IBGN -- value to use to find duplicates
|
|---|
| 63 | ;
|
|---|
| 64 | N INP,LEN,SUB,TYPE
|
|---|
| 65 | F SUB="AGNA","AGNU","ACCP" D
|
|---|
| 66 | .I SUB="ACCP" S IBGN=$$COMP^IBCNSJ(IBGN)
|
|---|
| 67 | .S INP=IBGN,LEN=$L(INP) Q:LEN<2!(LEN>20)
|
|---|
| 68 | .S TYPE=$S(IBGN?1N.N:"NUM",1:"STR")
|
|---|
| 69 | .I $D(^IBA(355.3,SUB,IBCNS,INP)) D GDATA
|
|---|
| 70 | .I TYPE="STR" F S INP=$O(^IBA(355.3,SUB,IBCNS,INP)) Q:$E(INP,1,LEN)'=IBGN D GDATA
|
|---|
| 71 | .I TYPE="NUM" F S INP=$O(^IBA(355.3,SUB,IBCNS,INP)) Q:INP="" I $E(INP,1,LEN)=IBGN D GDATA
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | GDATA ; Place potential duplicate plan into an array.
|
|---|
| 75 | N X,Y S X=0
|
|---|
| 76 | F S X=$O(^IBA(355.3,SUB,IBCNS,INP,X)) Q:'X I '$D(^TMP($J,"DUP",X)) D
|
|---|
| 77 | .S Y=$G(^IBA(355.3,X,0)),IBCT=IBCT+1
|
|---|
| 78 | .S ^TMP($J,"DUP",X)="",^TMP($J,"DUP1",IBCT)=$P(Y,"^",4)_U_$P(Y,"^",3)_U_$P(Y,"^",2)_U_$P(Y,"^",11)
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | LIST ; List potential duplicates to screen and prompt to add plan.
|
|---|
| 82 | W !!," The following plans have been identified as potential duplicates:"
|
|---|
| 83 | W !!,?3,"PLAN",?22,"PLAN",?45,"GROUP",?55,"ACTIVE",!,?2,"NUMBER",?22,"NAME",?45,"PLAN?",?55,"PLAN?",!
|
|---|
| 84 | S IBCT=0 F S IBCT=$O(^TMP($J,"DUP1",IBCT)) Q:'IBCT D
|
|---|
| 85 | .S IBST=$G(^TMP($J,"DUP1",IBCT))
|
|---|
| 86 | .W !?2,$S($P(IBST,"^")'="":$P(IBST,"^"),1:"<NO PLAN NUM>"),?22,$S($P(IBST,"^",2)'="":$P(IBST,"^",2),1:"<NO PLAN NAME>")
|
|---|
| 87 | .W ?45,$S($P(IBST,"^",3)'="":$$EXPAND^IBTRE(355.3,.02,$P(IBST,"^",3)),1:"<UNK>"),?55,$S($P(IBST,"^",4):"NO",1:"YES")
|
|---|
| 88 | ;
|
|---|
| 89 | ; - see if it is okay to add the plan
|
|---|
| 90 | S DIR(0)="Y",DIR("A",1)="Do you still want to add a new plan with Plan Name "_$S(IBGNA'="":IBGNA,1:"<NO PLAN NAME>")
|
|---|
| 91 | S DIR("A")="and Plan Number "_$S(IBGNU'="":IBGNU,1:"<NO PLAN NUMBER>")
|
|---|
| 92 | S DIR("B")="NO"
|
|---|
| 93 | W ! D ^DIR K DIR S IBANS=Y
|
|---|
| 94 | Q
|
|---|
