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

IBCNSP11.m

Go to the documentation of this file. 
  1. IBCNSP11 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT PLAN ;23-JAN-95
  1.  ;;2.0;INTEGRATED BILLING;**28,43,85,103,137,251,399,516,549**;21-MAR-94;Build 54
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. PI ; -- edit plan information from policy edit
  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 Plan Information."
  1.  . K DIR
  1.  . D PAUSE^VALM1
  1.  . S VALMBCK="R"
  1.  ;
  1.  N IBCDFN,IBCPOL
  1.  S IBCDFN=$P($G(IBPPOL),"^",4)
  1.  ;
  1.  ; - build a plan on the fly if there is not one present
  1.  S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
  1.  I IBCPOL="" S IBCPOL=$$CHIP^IBCNSU($G(^DPT(DFN,.312,IBCDFN,0))) I IBCPOL D  ;Stuff in file
  1.  .S DIE="^DPT("_DFN_",.312,",DR=".18////"_IBCPOL
  1.  .S DA=IBCDFN,DA(1)=DFN
  1.  .D ^DIE
  1.  .K DA,DR,DIE,DIC
  1.  .Q
  1.  D PIEDIT(IBCPOL,DFN,IBCDFN)
  1.  Q
  1.  ;
  1. PI1 ; -- edit plan information from plan edit
  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 Plan Information."
  1.  . K DIR
  1.  . D PAUSE^VALM1
  1.  . S VALMBCK="R"
  1.  ;
  1.  D PIEDIT(IBCPOL,"","")
  1.  Q
  1.  ;
  1. PIEDIT(IBCPOL,IBDFN,IBCDFN) ;Entry point if already have the plan (IBCPOL)
  1.  ; -- Edit the plan specific info
  1.  ; The following parameters are only used when editing plan via the patient policy
  1.  ; IBDFN = DFN of patient
  1.  ; IBCDFN = entry # of multiple for policy in .312 nodes of ^DPT
  1.  N DIRUT,DTOUT,DUOUT,DIROUT,IBDIF,DA,DR,DIC,DIE,IBCPOLD,IBGRP,IBTL,IBCNSEH,IBSUB
  1.  D SAVE^IBCNSP3(IBCPOL)
  1.  L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G PIQ
  1.  S IBCNSEH=$S($G(IBDFN):+$G(^IBE(350.9,1,4)),1:0) D POL^IBCNSEH
  1.  S IBCPOLD=$G(^IBA(355.3,IBCPOL,0)),IBGRP=$P(IBCPOLD,"^",2)
  1.  I $P(IBCPOLD,"^",11) W !?2,*7,"Please note that this plan is inactive!",!
  1.  W !,"This plan is currently defined as a",$S(IBGRP:" Group",1:"n Individual")," Plan."
  1.  S IBSUB=$$SUBS^IBCNSJ(+$G(^IBA(355.3,IBCPOL,0)),IBCPOL,0,"",1)
  1.  I 'IBGRP,IBSUB>1 W !!,"This Individual Plan has more than one subscriber!" G CHG
  1.  I IBGRP,IBSUB>1 W !!,"There is more than one subscriber to this Group Plan.  The plan cannot",!,"be changed to an individual plan.",! G PIC
  1.  ;
  1.  ; - switch the plan to group/individual
  1.  S DIR("A")="Do you wish to change this plan to a"_$S(IBGRP:"n Individual",1:" Group")_" Plan"
  1.  S DIR(0)="Y",DIR("?")="Enter 'YES' to change this plan, or enter 'NO' to leave it as is."
  1.  D ^DIR K DIR I $D(DIRUT) G PIQ1
  1.  I 'Y W !,"No change was made.",! G PIC
  1.  ;
  1. CHG ; - change the plan type
  1.  W !,"Changing the plan to a",$S(IBGRP:"n Individual",1:" Group")," Plan... "
  1.  S DIE="^IBA(355.3,",DA=IBCPOL,DR=".02////"_$S(IBGRP:0,1:1)_";.1////"_$S(IBGRP&$G(IBDFN):IBDFN,1:"@")
  1.  D ^DIE K DIE,DA,DR W "done.",!
  1.  ;
  1. PIC ; - edit name/number/type
  1.  S IBTL=$S($P($G(^IBA(355.3,IBCPOL,0)),"^",2):"GROUP",1:"INDIVIDUAL")_" PLAN"
  1.  S DIE="^IBA(355.3,",DA=IBCPOL
  1.  ;IB*2.0*516/baa Use HIPAA Compliant fields - .03 to 2.01 .04 to 2.02
  1.  ;S DR=".03"_IBTL_" NAME;.04"_IBTL_" NUMBER;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^IBA(355.3,IBCPOL,0),U,14)):""@1"",1:""@10"");@1;.14;@10;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13"
  1.  S DR="2.01"_IBTL_" NAME;2.02"_IBTL_" NUMBER;6.02;6.03;.09;.15;S Y=$S($$CATOK^IBCEMRA($P(^IBA(355.3,IBCPOL,0),U,14)):""@1"",1:""@10"");@1;.14;@10;.16;I '$$FTFV^IBCNSU31(X) S Y=""@13"";.17;@13;.13"
  1.  ;
  1.  D ^DIE K DIC,DIE,DA,DR
  1.  D COMP^IBCNSP3(IBCPOL)
  1.  I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBDFN) UPDATPT^IBCNSP3(IBDFN,IBCDFN),BLD^IBCNSP D:'$G(IBDFN) INIT^IBCNSC4
  1. PIQ1 L -^IBA(355.3,+IBCPOL)
  1. PIQ S VALMBCK="R"
  1.  Q