Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSM31

IBCNSM31.m

Go to the documentation of this file.
  1. IBCNSM31 ;ALB/AAS/JNM - INSURANCE MANAGEMENT - OUTPUTS ;28-MAY-93
  1. ;;2.0;INTEGRATED BILLING;**6,28,68,413,497,516,549**;21-MAR-94;Build 54
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. % G EN^IBCNSM
  1. ;
  1. EA ; -- Edit all insurance policy data
  1. N IBDIF,I,J,IBXX,IBCDFN,IBTRC,VALMY
  1. D EN^VALM2($G(XQORNOD(0)))
  1. D FULL^VALM1
  1. ;
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to Edit All"
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . D EAQ
  1. ;
  1. I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D ;W !,"Entry ",X,"Selected" D
  1. .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
  1. .Q:IBPPOL=""
  1. .S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" Q
  1. .; -- edit patient data
  1. .N IBQUIT S IBQUIT=0
  1. .S IBCNSEH=$P($G(^IBE(350.9,1,4)),"^",1) D PAT^IBCNSEH
  1. .D BEFORE^IBCNSEVT
  1. .D PATPOL^IBCNSM32(IBCDFN)
  1. .D AFTER^IBCNSEVT,^IBCNSEVT
  1. .; -- edit policy data
  1. .D:'$G(IBQUIT) POL^IBCNSEH,EDPOL^IBCNSM3(IBCDFN)
  1. .W ! D AI^IBCNSP1 D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
  1. .Q
  1. ;
  1. EAQ D BLD^IBCNSM
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. LK(IBCNS) ; -- screened look up to policy file
  1. ; input: IBCNS = pointer to insurance company file (36)
  1. ;
  1. N DIC,IBX,DIR,DUOUT,DTOUT,DIROUT,DIRUT,X,Y,IBCPOL
  1. S IBCPOL=""
  1. I $G(IBCNS)="" G LKQ
  1. ;
  1. I '$$ANYGP^IBCNSJ(IBCNS) W !!,"This company does not offer any active group plans." G LKQ
  1. ;
  1. S DIR(0)="Y",DIR("A")="This company offers active group plans. Do you wish to select one"
  1. 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."
  1. D ^DIR K DIR I 'Y G LKQ
  1. ;
  1. S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to directly enter this plan"
  1. 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."
  1. D ^DIR K DIR I $D(DIRUT) G LKQ
  1. ;
  1. I 'Y D LKP^IBCNSU2(IBCNS,0,0,.IBCPOL,$G(IBALR)) G LKQ
  1. ;
  1. ; MRD;IB*2.0*516 - Display new Group Name and Number fields.
  1. S DIC("A")="Select an Active GROUP PLAN: "
  1. S DIC="^IBA(355.3,",DIC(0)="AEQM",DIC("S")="I +^(0)=IBCNS,$P(^(0),U,2),'$P(^(0),U,11),$G(IBALR)'=+Y"
  1. ;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>"")"
  1. 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)"
  1. D ^DIC K DIC I +Y>0 S IBCPOL=+Y
  1. ;
  1. ; -- see if only one policy
  1. ;I '$O(^IBA(355.3,"B",+IBCNS,IBX) D G LKQ
  1. ;
  1. ; -- is more than one plan to choose from, let fileman do it.
  1. ;S DIC("A")="Select GROUP INSURANCE PLAN: "
  1. ;
  1. ;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)))"
  1. ;
  1. ;D ^DIC K DIC I +Y>0 S IBCPOL=+Y
  1. ;
  1. LKQ Q IBCPOL
  1. ;
  1. FUTURE ; -- if expiration date in future give warning
  1. I $G(IBFUTUR) K IBFUTUR Q
  1. 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"
  1. S IBFUTUR=1
  1. Q
  1. ;
  1. COVERED(DFN,IBCOVP) ; -- update covered by insurance in background
  1. ; -- input ibcovp = the covered by insurance field prior to editing
  1. ; (add/edit/delete) of the 2.312 insurance type mult.
  1. ;
  1. Q:$G(DFN)<1
  1. N X,Y,I,IBCOV,IBNCOV,DA,DR,DIE,DIC,IBINS,IBINSD
  1. S (IBCOV,IBNCOV)=$P($G(^DPT(DFN,.31)),"^",11)
  1. D ALL^IBCNS1(DFN,"IBINS",2,DT) S IBINSD=+$G(IBINS(0))
  1. ;
  1. ; -- initial value ="" or Unknown
  1. I $G(IBCOVP)=""!($G(IBCOVP)="U") S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"U",IBINSD:"Y",1:"N")
  1. ;
  1. ; -- initial value = YES or NO (treat the same)
  1. I $G(IBCOVP)="Y"!($G(IBCOVP)="N") S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"N",IBINSD:"Y",1:"N")
  1. ;
  1. ;
  1. I IBCOV'=IBNCOV D
  1. .S DIE="^DPT(",DR=".3192////"_IBNCOV,DA=DFN D ^DIE
  1. .I '$D(ZTQUEUED)&($G(IBSUPRES)'>0) W !!,"COVERED BY HEALTH INSURANCE changed to '"_$S(IBNCOV="Y":"YES",IBNCOV="N":"NO",1:"UNKNOWN"),"'.",! H 3
  1. .Q
  1. Q
  1. ;
  1. 3 ; -- display group name as uneditable
  1. ; called by die, expects da = entry in 355.3
  1. N X
  1. S X=$P($G(^IBA(355.3,DA,2)),"^",1) ; IB*2.0*497 (vd)
  1. W !,"GROUP NAME: ",X,$S(X'="":"// ",1:"")," (No Editing)"
  1. Q
  1. ;
  1. 4 ; -- display group number as uneditable
  1. ; called by die, expects da = entry in 355.3
  1. N X
  1. S X=$P($G(^IBA(355.3,DA,2)),"^",2) ; IB*2.0*497 (vd)
  1. W !,"GROUP NUMBER: ",X,$S(X'="":"// ",1:"")," (No Editing)"
  1. Q