source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJYPT.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1IBJYPT ;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 ;
16LT ; install list templates
17 W !!!,?4,"LIST TEMPLATE INSTALLATION",!!
18 D ^IBJYL
19 W !,"OK, List Template Installation is Complete."
20 Q
21 ;
22XREF ; 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 ;
33MENU ; 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 ;
43MSET 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
Note: See TracBrowser for help on using the repository browser.