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

IBYAPT.m

Go to the documentation of this file. 
  1. IBYAPT ;ALB/CPM - PATCH IB*2*28 POST-INITIALIZATION ; 25-JAN-95
  1.  ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
  1.  ;
  1. EN ; Patch IB*2*28 post initialization.
  1.  ;
  1.  D DEL ;          delete IBCNS QUIT as an item of IBCNSC INSURANCE CO
  1.  D ^IBYAONIT ;    install protocols
  1.  D BLD ;          update ^XUTL("XQORM" for menu protocols
  1.  D TEM ;          install list templates
  1.  D ADD ;          add new option to the Ins Mgmt menu
  1.  D REF ;          build x-refs
  1.  D BKG^IBYAPT1 ;  queue off insurance clean-up
  1.  Q
  1.  ;
  1.  ;
  1. DEL ; Delete IBCNS QUIT from the item multiple of IBCNSC INSURANCE CO.
  1.  S DIC(0)="F",DIC="^ORD(101,",X="IBCNSC INSURANCE CO"
  1.  D ^DIC K DIC Q:Y<0  S IBMENU=+Y
  1.  S DIC(0)="F",DIC="^ORD(101,"_IBMENU_",10,",DA(1)=IBMENU,X="IBCNS QUIT"
  1.  D ^DIC K DIC Q:Y<0  S IBITEM=+Y
  1.  W !!,">>> Deleting protocol IBCNS QUIT as an item of IBCNSC INSURANCE CO..."
  1.  W !,"    (It will be added back in momentarily)"
  1.  S DA(1)=IBMENU,DA=IBITEM,DIK="^ORD(101,"_IBMENU_",10," D ^DIK
  1.  K DA,DIK,IBITEM,IBMENU
  1.  Q
  1.  ;
  1. BLD ; Update ^XUTL("XQORM" for menu protocols.
  1.  W !
  1.  F IBX="IBCNSJ PLAN LOOKUP","IBCNSP POLICY MENU","IBCNSC INSURANCE CO" D
  1.  .S DIC="^ORD(101,",DIC(0)="F",X=IBX D ^DIC K DIC S IBY=+Y
  1.  .I IBY>0 D
  1.  ..W !,">>> Rebuilding ^XUTL(""XQORM"" for protocol '",IBX,"' ..."
  1.  ..S XQORM=IBY_";ORD(101," D XREF^XQORM
  1.  K IBX,IBY,ORULT,X,XQORM,Y
  1.  Q
  1.  ;
  1. TEM ; Install List Templates
  1.  W !!,">>> Installing List Templates..."
  1.  W !,"'IBCNS EXPANDED POLICY' List Template..."
  1.  S DA=$O(^SD(409.61,"B","IBCNS EXPANDED POLICY",0)),DIK="^SD(409.61," D ^DIK:DA
  1.  K DO,DD S DIC(0)="L",DIC="^SD(409.61,",X="IBCNS EXPANDED POLICY" D FILE^DICN S VALM=+Y
  1.  I VALM>0 D
  1.  .S ^SD(409.61,VALM,0)="IBCNS EXPANDED POLICY^1^^80^5^17^1^1^Policy^IBCNSP POLICY MENU^Patient Policy Information^1"
  1.  .S ^SD(409.61,VALM,1)="^VALM HIDDEN ACTIONS"
  1.  .S ^SD(409.61,VALM,"ARRAY")=" ^TMP(""IBCNSVP"",$J)"
  1.  .S ^SD(409.61,VALM,"COL",0)="^409.621^^0"
  1.  .S ^SD(409.61,VALM,"FNL")="D EXIT^IBCNSP"
  1.  .S ^SD(409.61,VALM,"HDR")="D HDR^IBCNSP"
  1.  .S ^SD(409.61,VALM,"HLP")="D HELP^IBCNSP"
  1.  .S ^SD(409.61,VALM,"INIT")="D INIT^IBCNSP"
  1.  .S DA=VALM,DIK="^SD(409.61," D IX1^DIK K DA,DIK
  1.  .W "Filed."
  1.  ;
  1.  W !,"'IBCNS PLAN LOOKUP' List Template..."
  1.  S DA=$O(^SD(409.61,"B","IBCNS PLAN LOOKUP",0)),DIK="^SD(409.61," D ^DIK:DA
  1.  K DO,DD S DIC(0)="L",DIC="^SD(409.61,",X="IBCNS PLAN LOOKUP" D FILE^DICN S VALM=+Y
  1.  I VALM>0 D
  1.  .S ^SD(409.61,VALM,0)="IBCNS PLAN LOOKUP^1^^80^7^19^1^1^Plan^IBCNSJ PLAN LOOKUP^Insurance Plan Lookup^1^^1"
  1.  .S ^SD(409.61,VALM,1)="^VALM HIDDEN ACTIONS"
  1.  .S ^SD(409.61,VALM,"ARRAY")=" ^TMP(""IBCNSJ"",$J)"
  1.  .S ^SD(409.61,VALM,"COL",0)="^409.621^8^8"
  1.  .S ^SD(409.61,VALM,"COL",1,0)="NUMBER^1^4^"
  1.  .S ^SD(409.61,VALM,"COL",2,0)="GNAME^5^18^Group Name"
  1.  .S ^SD(409.61,VALM,"COL",3,0)="GNUM^25^17^Group Number"
  1.  .S ^SD(409.61,VALM,"COL",4,0)="TYPE^44^13^Type of Plan"
  1.  .S ^SD(409.61,VALM,"COL",5,0)="UR^59^3^UR?"
  1.  .S ^SD(409.61,VALM,"COL",6,0)="PREC^64^3^Ct?"
  1.  .S ^SD(409.61,VALM,"COL",7,0)="PREEX^70^4^ExC?"
  1.  .S ^SD(409.61,VALM,"COL",8,0)="BENAS^76^3^As?"
  1.  .S ^SD(409.61,VALM,"FNL")="D FNL^IBCNSU2"
  1.  .S ^SD(409.61,VALM,"HDR")="D HDR^IBCNSU2"
  1.  .S ^SD(409.61,VALM,"HLP")="S X=""?"" D DISP^XQORM1 W !!"
  1.  .S ^SD(409.61,VALM,"INIT")="D INIT^IBCNSU2"
  1.  .S DA=VALM,DIK="^SD(409.61," D IX1^DIK K DA,DIK
  1.  .W "Filed."
  1.  ;
  1.  K DIC,DIK,VALM,X,DA Q
  1.  ;
  1. ADD ; Add the option List Plans by Insurance Company to the Ins Mgmt menu
  1.  S (IBUY,Y)=$O(^DIC(19,"B","IBCN INSURANCE MGMT MENU",0)) Q:Y=""
  1.  S X=$O(^DIC(19,"B","IBCN LIST PLANS BY INS CO",0)) Q:X=""
  1.  W !!,">>> Adding IBCN LIST PLANS BY INS CO option to the IBCN INSURANCE MGMT MENU..."
  1.  I '$D(^DIC(19,+Y,10,0)) S ^DIC(19,+Y,10,0)="^19.01IP^0^0"
  1.  S (DA,D0)=+Y,DIC="^DIC(19,"_+Y_",10,",DIC(0)="L",DA(1)=+Y,DLAYGO=19.01,X="IBCN LIST PLANS BY INS CO" D ^DIC
  1.  S DA=+Y,DIE="^DIC(19,"_DA(1)_",10,",DR="2///^S X=""LP""" D ^DIE
  1.  K DIC,DIE,DA,IBUY,DR,X,Y
  1.  Q
  1.  ;
  1. REF ; Build the ACCP, AGNA, and AGNU cross-references.
  1.  W !!,">>> Building the 'ACCP' cross-reference for file #355.3 ..."
  1.  W !,"    (I'll write a dot for every 100 entries processed)",!
  1.  S (IBCT,IBP)=0
  1.  F IB=1:1 S IBP=$O(^IBA(355.3,IBP)) Q:'IBP  S IBPD=$G(^(IBP,0)) I IBPD D
  1.  .W:'(IB#100) "."
  1.  .S IBX=$P(IBPD,"^",3) I IBX]"" D
  1.  ..S ^IBA(355.3,"AGNA",+IBPD,IBX,IBP)=""
  1.  ..S Y=$$COMP^IBCNSJ(IBX) I Y]"" S ^IBA(355.3,"ACCP",+IBPD,Y,IBP)=""
  1.  .S IBX=$P(IBPD,"^",4) I IBX]"" D
  1.  ..S ^IBA(355.3,"AGNU",+IBPD,IBX,IBP)=""
  1.  ..S Y=$$COMP^IBCNSJ(IBX) I Y]"" S ^IBA(355.3,"ACCP",+IBPD,Y,IBP)=""
  1.  .I $P(IBPD,"^",2),$P(IBPD,"^",10) D
  1.  ..S DIE="^IBA(355.3,",DA=IBP,DR=".1////@;1.05///NOW;1.06////"_DUZ
  1.  ..D ^DIE K DIE,DA,DR S IBCT=IBCT+1
  1.  I IBCT W !?4,"Note that ",IBCT," group plan",$S(IBCT>1:"s",1:"")," had the individual policy pointer removed."
  1.  K IBCT,IBP,IB,IBPD,IBX,Y
  1.  Q