| [613] | 1 | IBCNSM31 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 28-MAY-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**6,28,68**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | % G EN^IBCNSM
|
|---|
| 6 | ;
|
|---|
| 7 | EA ; -- Edit all insurance policy data
|
|---|
| 8 | N IBDIF,I,J,IBXX,IBCDFN,IBTRC,VALMY
|
|---|
| 9 | D EN^VALM2($G(XQORNOD(0)))
|
|---|
| 10 | D FULL^VALM1
|
|---|
| 11 | I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D ;W !,"Entry ",X,"Selected" D
|
|---|
| 12 | .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
|
|---|
| 13 | .Q:IBPPOL=""
|
|---|
| 14 | .S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" Q
|
|---|
| 15 | .; -- edit patient data
|
|---|
| 16 | .N IBQUIT S IBQUIT=0
|
|---|
| 17 | .S IBCNSEH=$P($G(^IBE(350.9,1,4)),"^",1) D PAT^IBCNSEH
|
|---|
| 18 | .D BEFORE^IBCNSEVT
|
|---|
| 19 | .D PATPOL^IBCNSM32(IBCDFN)
|
|---|
| 20 | .D AFTER^IBCNSEVT,^IBCNSEVT
|
|---|
| 21 | .; -- edit policy data
|
|---|
| 22 | .D:'$G(IBQUIT) POL^IBCNSEH,EDPOL^IBCNSM3(IBCDFN)
|
|---|
| 23 | .W ! D AI^IBCNSP1 D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
|
|---|
| 24 | .Q
|
|---|
| 25 | ;
|
|---|
| 26 | EAQ D BLD^IBCNSM
|
|---|
| 27 | S VALMBCK="R"
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | LK(IBCNS) ; -- screened look up to policy file
|
|---|
| 31 | ; input: IBCNS = pointer to insurance company file (36)
|
|---|
| 32 | ;
|
|---|
| 33 | N DIC,IBX,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,IBCPOL
|
|---|
| 34 | S IBCPOL=""
|
|---|
| 35 | I $G(IBCNS)="" G LKQ
|
|---|
| 36 | ;
|
|---|
| 37 | I '$$ANYGP^IBCNSJ(IBCNS) W !!,"This company does not offer any active group plans." G LKQ
|
|---|
| 38 | ;
|
|---|
| 39 | S DIR(0)="Y",DIR("A")="This company offers active group plans. Do you wish to select one"
|
|---|
| 40 | S DIR("?")="The look-up facility to select an active group plan has been enhanced to use the List Manager. Enter 'YES' if you wish to select a plan from this look-up, or 'NO' to add your own plan."
|
|---|
| 41 | D ^DIR K DIR I 'Y G LKQ
|
|---|
| 42 | ;
|
|---|
| 43 | S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to directly enter this plan"
|
|---|
| 44 | S DIR("?")="The look-up facility to select an active 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."
|
|---|
| 45 | D ^DIR K DIR I $D(DIRUT) G LKQ
|
|---|
| 46 | ;
|
|---|
| 47 | I 'Y D LKP^IBCNSU2(IBCNS,0,0,.IBCPOL,$G(IBALR)) G LKQ
|
|---|
| 48 | ;
|
|---|
| 49 | S DIC("A")="Select an Active GROUP PLAN: "
|
|---|
| 50 | S DIC="^IBA(355.3,",DIC(0)="AEQM",DIC("S")="I +^(0)=IBCNS,$P(^(0),U,2),'$P(^(0),U,11),$G(IBALR)'=+Y"
|
|---|
| 51 | 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>"")"
|
|---|
| 52 | D ^DIC K DIC I +Y>0 S IBCPOL=+Y
|
|---|
| 53 | ;
|
|---|
| 54 | ; -- see if only one policy
|
|---|
| 55 | ;I '$O(^IBA(355.3,"B",+IBCNS,IBX) D G LKQ
|
|---|
| 56 | ;
|
|---|
| 57 | ; -- is more than one plan to choose from, let fileman do it.
|
|---|
| 58 | ;S DIC("A")="Select GROUP INSURANCE PLAN: "
|
|---|
| 59 | ;
|
|---|
| 60 | ;S DIC="^IBA(355.3,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U)=IBCNS,($P(^(0),U,2)=1!($P(^(0),U,10)=$G(DFN)))"
|
|---|
| 61 | ;
|
|---|
| 62 | ;D ^DIC K DIC I +Y>0 S IBCPOL=+Y
|
|---|
| 63 | ;
|
|---|
| 64 | LKQ Q IBCPOL
|
|---|
| 65 | ;
|
|---|
| 66 | FUTURE ; -- if expiration date in future give warning
|
|---|
| 67 | I $G(IBFUTUR) K IBFUTUR Q
|
|---|
| 68 | I $P(^DPT(DFN,.312,IBCDFN,0),"^",4),$P(^(0),"^",4)>DT W !!,*7,"WARNING: The expiration date for this policy is in the future!",!," Normally this is a past date or left blank or a past date",! S Y="@333"
|
|---|
| 69 | S IBFUTUR=1
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | COVERED(DFN,IBCOVP) ; -- update covered by insurance in background
|
|---|
| 73 | ; -- input ibcovp = the covered by insurance field prior to editing
|
|---|
| 74 | ; (add/edit/delete) of the 2.312 insurance type mult.
|
|---|
| 75 | ;
|
|---|
| 76 | Q:$G(DFN)<1
|
|---|
| 77 | N X,Y,I,IBCOV,IBNCOV,DA,DR,DIE,DIC,IBINS,IBINSD
|
|---|
| 78 | S (IBCOV,IBNCOV)=$P($G(^DPT(DFN,.31)),"^",11)
|
|---|
| 79 | D ALL^IBCNS1(DFN,"IBINS",2,DT) S IBINSD=+$G(IBINS(0))
|
|---|
| 80 | ;
|
|---|
| 81 | ; -- initial value ="" or Unknown
|
|---|
| 82 | I $G(IBCOVP)=""!($G(IBCOVP)="U") S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"U",IBINSD:"Y",1:"N")
|
|---|
| 83 | ;
|
|---|
| 84 | ; -- initial value = YES or NO (treat the same)
|
|---|
| 85 | I $G(IBCOVP)="Y"!($G(IBCOVP)="N") S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"N",IBINSD:"Y",1:"N")
|
|---|
| 86 | ;
|
|---|
| 87 | ;
|
|---|
| 88 | I IBCOV'=IBNCOV D
|
|---|
| 89 | .S DIE="^DPT(",DR=".3192////"_IBNCOV,DA=DFN D ^DIE
|
|---|
| 90 | .I '$D(ZTQUEUED) W !!,"COVERED BY HEALTH INSURANCE changed to '"_$S(IBNCOV="Y":"YES",IBNCOV="N":"NO",1:"UNKNOWN"),"'.",!
|
|---|
| 91 | .H 3
|
|---|
| 92 | .Q
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | 3 ; -- display group name as uneditable
|
|---|
| 96 | ; called by die, expects da = entry in 355.3
|
|---|
| 97 | N X
|
|---|
| 98 | S X=$P($G(^IBA(355.3,DA,0)),"^",3)
|
|---|
| 99 | W !,"GROUP NAME: ",X,$S(X'="":"// ",1:"")," (No Editing)"
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | 4 ; -- display group number as uneditable
|
|---|
| 103 | ; called by die, expects da = entry in 355.3
|
|---|
| 104 | N X
|
|---|
| 105 | S X=$P($G(^IBA(355.3,DA,0)),"^",4)
|
|---|
| 106 | W !,"GROUP NUMBER: ",X,$S(X'="":"// ",1:"")," (No Editing)"
|
|---|
| 107 | Q
|
|---|
