| 1 | IBJYPT ;ALB/ARH - IBJ V2.0 POST-INITIALIZATION ROUTINE ; 05-AUG-92
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | ; Perform one-time post init items
|
|---|
| 5 | ;
|
|---|
| 6 | ; Run at every installation
|
|---|
| 7 | ;
|
|---|
| 8 | D ^IBJONIT ; install protocols
|
|---|
| 9 | D LT ; install list templates
|
|---|
| 10 | D MENU ; add new options to menus
|
|---|
| 11 | D XREF ; index APDS cross reference
|
|---|
| 12 | ;
|
|---|
| 13 | W !!,"Installation Complete."
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | LT ; install list templates
|
|---|
| 17 | W !!!,?4,"LIST TEMPLATE INSTALLATION",!!
|
|---|
| 18 | D ^IBJYL
|
|---|
| 19 | W !,"OK, List Template Installation is Complete."
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | XREF ; build 'APDS' cross reference
|
|---|
| 23 | ;
|
|---|
| 24 | N DA,CT,X,Y,IBH1,IBH2
|
|---|
| 25 | ;
|
|---|
| 26 | I $D(^DGCR(399,"APDS")) W !!,"*** APDS cross reference already exists on #399, will not be re-built ***",!! Q
|
|---|
| 27 | W !!,">>> Building the 'APDS' cross reference on field 399,151.",!,?5,"(I'll write a dot for every 500 entries processed)",!
|
|---|
| 28 | S (CT,DA)=0 F S DA=$O(^DGCR(399,DA)) Q:'DA S CT=CT+1,X=$P($G(^DGCR(399,DA,0)),U,2),Y=+$G(^DGCR(399,DA,"U")) W:'(CT#50) "." I +X,+Y S ^DGCR(399,"APDS",+X,-Y,DA)=""
|
|---|
| 29 | ;
|
|---|
| 30 | W !,?5,"Cross Reference build complete.",!!
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | MENU ; add new options to menus
|
|---|
| 34 | ;
|
|---|
| 35 | S IBMNU="SITE",IBOPTION="IBJ MCCR SITE PARAMETERS",IBMENU="IB SYSTEM DEFINITION MENU" D MSET
|
|---|
| 36 | S IBMNU="TPJI",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IB BILLING SUPERVISOR MENU" D MSET
|
|---|
| 37 | S IBMNU="TPJI",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IB BILLING CLERK MENU" D MSET
|
|---|
| 38 | S IBMNU="TP",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IBT USER MENU (BI)" D MSET
|
|---|
| 39 | S IBMNU="TP",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IBT USER MENU (IR)" D MSET
|
|---|
| 40 | K IBMNU,IBOPTION,IBMENU,IBDAM,IBDAO
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | MSET S IBDAM=$O(^DIC(19,"B",IBMENU,0))
|
|---|
| 44 | I 'IBDAM W !!,"*** Unable to find ",IBMENU,", could not add ",IBOPTION," ***" Q
|
|---|
| 45 | S IBDAO=$O(^DIC(19,"B",IBOPTION,0))
|
|---|
| 46 | I 'IBDAO W !!,"*** Unable to find new option ",IBOPTION,", could not add it to ",IBMENU," ***" Q
|
|---|
| 47 | ;
|
|---|
| 48 | I $O(^DIC(19,+IBDAM,10,"B",+IBDAO,0)) W !!,"*** ",IBOPTION," already on ",IBMENU," ***" Q
|
|---|
| 49 | ;
|
|---|
| 50 | W !!,">>> Adding ",IBOPTION," option to ",IBMENU
|
|---|
| 51 | I '$D(^DIC(19,+IBDAM,10,0)) S ^DIC(19,+IBDAM,10,0)="^19.01IP^0^0"
|
|---|
| 52 | S (Y,DA,D0)=+IBDAM,DIC="^DIC(19,"_+IBDAM_",10,",DIC(0)="L",DA(1)=+IBDAM,DLAYGO=19.01,X=IBOPTION D ^DIC
|
|---|
| 53 | S DA=+Y,DIE="^DIC(19,"_DA(1)_",10,",DR="2///"_IBMNU D ^DIE
|
|---|
| 54 | K DIC,DIE,DA,DR,D0,DLAYGO,IBDAM,IBDAO,X,Y
|
|---|
| 55 | Q
|
|---|
