| [613] | 1 | IBCNSJ ;ALB/CPM - INSURANCE PLAN UTILITIES ; 30-DEC-94
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**28,43**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DEL(IBPLAN) ; Delete an Insurance Plan
|
|---|
| 6 | ; Input: IBPLAN -- Pointer to the plan in file #355.3
|
|---|
| 7 | ;
|
|---|
| 8 | I '$G(IBPLAN) G DELQ
|
|---|
| 9 | N DA,DIDEL,DIK,IBX
|
|---|
| 10 | ;
|
|---|
| 11 | ; - delete all associated Benefits Used
|
|---|
| 12 | S IBX=0 F S IBX=$O(^IBA(355.5,"B",IBPLAN,IBX)) Q:'IBX D DBU(IBX)
|
|---|
| 13 | ;
|
|---|
| 14 | ; - delete all associated Annual Benefits
|
|---|
| 15 | S IBX=0 F S IBX=$O(^IBA(355.4,"C",IBPLAN,IBX)) Q:'IBX S DA=IBX,DIDEL=355.4,DIK="^IBA(355.4," D ^DIK
|
|---|
| 16 | ;
|
|---|
| 17 | ; - delete all associated coverage limitations
|
|---|
| 18 | S IBX=0 F S IBX=$O(^IBA(355.32,"B",IBPLAN,IBX)) Q:'IBX S DA=IBX,DIDEL=355.32,DIK="^IBA(355.32," D ^DIK
|
|---|
| 19 | ;
|
|---|
| 20 | ; - delete the plan itself
|
|---|
| 21 | S DA=IBPLAN,DIDEL=355.3,DIK="^IBA(355.3," D ^DIK
|
|---|
| 22 | DELQ Q
|
|---|
| 23 | ;
|
|---|
| 24 | DBU(DA) ; Delete Benefits Used.
|
|---|
| 25 | N DIDEL,DIK
|
|---|
| 26 | I $G(DA) S DIDEL=355.5,DIK="^IBA(355.5," D ^DIK
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | IRACT(IBPLAN,IBF) ; Inactivate/reactivate an Insurance Plan
|
|---|
| 30 | ; Input: IBPLAN -- Pointer to the plan in file #355.3
|
|---|
| 31 | ; IBF -- 1 -> plan is to be inactivated
|
|---|
| 32 | ; 0 -> plan is to be reactivated
|
|---|
| 33 | ;
|
|---|
| 34 | I '$G(IBPLAN)!("^0^1^"'[("^"_$G(IBF)_"^")) G IRACTQ
|
|---|
| 35 | N DA,DIE,DR,X,Y
|
|---|
| 36 | S DA=IBPLAN,DR=".11////"_IBF,DIE="^IBA(355.3," D ^DIE
|
|---|
| 37 | D UPDATE^IBCNSP3(IBPLAN)
|
|---|
| 38 | IRACTQ Q
|
|---|
| 39 | ;
|
|---|
| 40 | COV(DFN) ; Update 'Covered by Insurance?' prompt
|
|---|
| 41 | ; Input: DFN -- Pointer to the patient in file #2
|
|---|
| 42 | ;
|
|---|
| 43 | ; This call differs from COVERED^IBCNSM31 in that field #.3192
|
|---|
| 44 | ; was not edited by the user, but an action on a plan or policy
|
|---|
| 45 | ; may require that this field be changed. Plus, there is no
|
|---|
| 46 | ; output to the screen.
|
|---|
| 47 | ;
|
|---|
| 48 | I '$G(DFN) G COVQ
|
|---|
| 49 | N X,Y,I,IBCOV,IBNCOV,DA,DR,DIE,DIC,IBINS,IBINSD
|
|---|
| 50 | S (IBCOV,IBNCOV)=$P($G(^DPT(DFN,.31)),"^",11)
|
|---|
| 51 | D ALL^IBCNS1(DFN,"IBINS",2,DT) S IBINSD=+$G(IBINS(0))
|
|---|
| 52 | S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"N",IBINSD:"Y",1:"N")
|
|---|
| 53 | I IBCOV'=IBNCOV S DIE="^DPT(",DR=".3192////"_IBNCOV,DA=DFN D ^DIE
|
|---|
| 54 | COVQ Q
|
|---|
| 55 | ;
|
|---|
| 56 | COMP(GN) ; Compress Insurance Plan Name or Number
|
|---|
| 57 | ; Convert to caps and strip punctuation and leading zeroes.
|
|---|
| 58 | ; Input: GN -- Insurance plan name or number to be compressed
|
|---|
| 59 | ; Output: GN1 -- The compressed name or number
|
|---|
| 60 | ;
|
|---|
| 61 | N GN1,X
|
|---|
| 62 | S GN1=GN I GN1?."0" S GN1="" G COMPQ
|
|---|
| 63 | S GN1=$TR(GN1,"abcdefghijklmnopqrstuvwxyz!"" #$%&,()*+'-./:;<=>?@[]_\{|}","ABCDEFGHIJKLMNOPQRSTUVWXYZ") ; change lower-case to upper, strip away all punctuation
|
|---|
| 64 | F X=1:1:$L(GN1) Q:$E(GN1,X)'="0" ; strip off leading zeroes
|
|---|
| 65 | S GN1=$E(GN1,X,$L(GN1))
|
|---|
| 66 | I GN1?."0" S GN1=""
|
|---|
| 67 | COMPQ Q GN1
|
|---|
| 68 | ;
|
|---|
| 69 | ANYGP(X,EX,ALL) ; Does this insurance company offer any group plans?
|
|---|
| 70 | ; Input: X -- Pointer to the company in file #36
|
|---|
| 71 | ; EX -- Pointer to an insurance plan in file #355.3
|
|---|
| 72 | ; This optional input parameter is used to exclude
|
|---|
| 73 | ; a specific plan from being considered.
|
|---|
| 74 | ; ALL -- Set to 1 if inactive plans are to be included
|
|---|
| 75 | ; Output: 0 -- Company doesn't offer any group plans
|
|---|
| 76 | ; 1 -- Company does offer group plans
|
|---|
| 77 | ;
|
|---|
| 78 | N I,J,Y S Y=0
|
|---|
| 79 | I '$G(X) G ANYGPQ
|
|---|
| 80 | S I=0 F S I=$O(^IBA(355.3,"B",X,I)) Q:'I D Q:Y
|
|---|
| 81 | .I $G(EX),I=EX Q
|
|---|
| 82 | .S J=$G(^IBA(355.3,I,0))
|
|---|
| 83 | .I $P(J,"^",2) D
|
|---|
| 84 | ..I $G(ALL) S Y=1 Q
|
|---|
| 85 | ..I '$P(J,"^",11) S Y=1
|
|---|
| 86 | ANYGPQ Q Y
|
|---|
| 87 | ;
|
|---|
| 88 | SUBS(CO,PLAN,ANY,ARR,Z) ; How many possible plan subscriptions are there?
|
|---|
| 89 | ; Input: CO -- Pointer to the company in file #36
|
|---|
| 90 | ; PLAN -- Pointer to the plan in file #355.3
|
|---|
| 91 | ; ANY -- [Optional] Set to 1 if at least one subscriber
|
|---|
| 92 | ; is to be found
|
|---|
| 93 | ; ARR -- [Optional] If defined, all policies will be
|
|---|
| 94 | ; returned in this array as
|
|---|
| 95 | ;
|
|---|
| 96 | ; ARR(DFN,ien)="", where
|
|---|
| 97 | ;
|
|---|
| 98 | ; DFN points to the patient in file #2, and
|
|---|
| 99 | ; 'ien' points to the policy in file #2.312
|
|---|
| 100 | ;
|
|---|
| 101 | ; Z -- [Optional] Set to 1 if the call is just to
|
|---|
| 102 | ; determine that there is more than one subscriber
|
|---|
| 103 | ;
|
|---|
| 104 | ; Output: Number of (potential) plan subscriptions
|
|---|
| 105 | ;
|
|---|
| 106 | N DFN,STOP,X,Y S (STOP,X)=0
|
|---|
| 107 | I '$G(CO)!'$G(PLAN) G SUBSQ
|
|---|
| 108 | S DFN=0 F S DFN=$O(^DPT("AB",CO,DFN)) Q:'DFN D Q:STOP
|
|---|
| 109 | .S Y=0 F S Y=$O(^DPT("AB",CO,DFN,Y)) Q:'Y I $P($G(^DPT(DFN,.312,Y,0)),"^",18)=PLAN S X=X+1 S:$G(ARR)]"" @ARR@(DFN,Y)="" I $G(ANY) S STOP=1 Q
|
|---|
| 110 | .I 'STOP,X>1,$G(Z) S STOP=1
|
|---|
| 111 | SUBSQ Q X
|
|---|
