IBJYPT ;ALB/ARH - IBJ V2.0 POST-INITIALIZATION ROUTINE ; 05-AUG-92
;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
;
; Perform one-time post init items
;
; Run at every installation
;
D ^IBJONIT ; install protocols
D LT ; install list templates
D MENU ; add new options to menus
D XREF ; index APDS cross reference
;
W !!,"Installation Complete."
Q
;
LT ; install list templates
W !!!,?4,"LIST TEMPLATE INSTALLATION",!!
D ^IBJYL
W !,"OK, List Template Installation is Complete."
Q
;
XREF ; build 'APDS' cross reference
;
N DA,CT,X,Y,IBH1,IBH2
;
I $D(^DGCR(399,"APDS")) W !!,"*** APDS cross reference already exists on #399, will not be re-built ***",!! Q
W !!,">>> Building the 'APDS' cross reference on field 399,151.",!,?5,"(I'll write a dot for every 500 entries processed)",!
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)=""
;
W !,?5,"Cross Reference build complete.",!!
Q
;
;
S IBMNU="SITE",IBOPTION="IBJ MCCR SITE PARAMETERS",IBMENU="IB SYSTEM DEFINITION MENU" D MSET
S IBMNU="TPJI",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IB BILLING SUPERVISOR MENU" D MSET
S IBMNU="TPJI",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IB BILLING CLERK MENU" D MSET
S IBMNU="TP",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IBT USER MENU (BI)" D MSET
S IBMNU="TP",IBOPTION="IBJ THIRD PARTY JOINT INQUIRY",IBMENU="IBT USER MENU (IR)" D MSET
K IBMNU,IBOPTION,IBMENU,IBDAM,IBDAO
Q
;
MSET S IBDAM=$O(^DIC(19,"B",IBMENU,0))
I 'IBDAM W !!,"*** Unable to find ",IBMENU,", could not add ",IBOPTION," ***" Q
S IBDAO=$O(^DIC(19,"B",IBOPTION,0))
I 'IBDAO W !!,"*** Unable to find new option ",IBOPTION,", could not add it to ",IBMENU," ***" Q
;
I $O(^DIC(19,+IBDAM,10,"B",+IBDAO,0)) W !!,"*** ",IBOPTION," already on ",IBMENU," ***" Q
;
W !!,">>> Adding ",IBOPTION," option to ",IBMENU
I '$D(^DIC(19,+IBDAM,10,0)) S ^DIC(19,+IBDAM,10,0)="^19.01IP^0^0"
S (Y,DA,D0)=+IBDAM,DIC="^DIC(19,"_+IBDAM_",10,",DIC(0)="L",DA(1)=+IBDAM,DLAYGO=19.01,X=IBOPTION D ^DIC
S DA=+Y,DIE="^DIC(19,"_DA(1)_",10,",DR="2///"_IBMNU D ^DIE
K DIC,DIE,DA,DR,D0,DLAYGO,IBDAM,IBDAO,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJYPT 2341 printed Dec 13, 2024@02:24:26 Page 2
IBJYPT ;ALB/ARH - IBJ V2.0 POST-INITIALIZATION ROUTINE ; 05-AUG-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
+2 ;
+3 ; Perform one-time post init items
+4 ;
+5 ; Run at every installation
+6 ;
+7 ; install protocols
DO ^IBJONIT
+8 ; install list templates
DO LT
+9 ; add new options to menus
DO MENU
+10 ; index APDS cross reference
DO XREF
+11 ;
+12 WRITE !!,"Installation Complete."
+13 QUIT
+14 ;
LT ; install list templates
+1 WRITE !!!,?4,"LIST TEMPLATE INSTALLATION",!!
+2 DO ^IBJYL
+3 WRITE !,"OK, List Template Installation is Complete."
+4 QUIT
+5 ;
XREF ; build 'APDS' cross reference
+1 ;
+2 NEW DA,CT,X,Y,IBH1,IBH2
+3 ;
+4 IF $DATA(^DGCR(399,"APDS"))
WRITE !!,"*** APDS cross reference already exists on #399, will not be re-built ***",!!
QUIT
+5 WRITE !!,">>> Building the 'APDS' cross reference on field 399,151.",!,?5,"(I'll write a dot for every 500 entries processed)",!
+6 SET (CT,DA)=0
FOR
SET DA=$ORDER(^DGCR(399,DA))
if 'DA
QUIT
SET CT=CT+1
SET X=$PIECE($GET(^DGCR(399,DA,0)),U,2)
SET Y=+$GET(^DGCR(399,DA,"U"))
if '(CT#50)
WRITE "."
IF +X
IF +Y
SET ^DGCR(399,"APDS",+X,-Y,DA)=""
+7 ;
+8 WRITE !,?5,"Cross Reference build complete.",!!
+9 QUIT
+10 ;
+1 ;
+2 SET IBMNU="SITE"
SET IBOPTION="IBJ MCCR SITE PARAMETERS"
SET IBMENU="IB SYSTEM DEFINITION MENU"
DO MSET
+3 SET IBMNU="TPJI"
SET IBOPTION="IBJ THIRD PARTY JOINT INQUIRY"
SET IBMENU="IB BILLING SUPERVISOR MENU"
DO MSET
+4 SET IBMNU="TPJI"
SET IBOPTION="IBJ THIRD PARTY JOINT INQUIRY"
SET IBMENU="IB BILLING CLERK MENU"
DO MSET
+5 SET IBMNU="TP"
SET IBOPTION="IBJ THIRD PARTY JOINT INQUIRY"
SET IBMENU="IBT USER MENU (BI)"
DO MSET
+6 SET IBMNU="TP"
SET IBOPTION="IBJ THIRD PARTY JOINT INQUIRY"
SET IBMENU="IBT USER MENU (IR)"
DO MSET
+7 KILL IBMNU,IBOPTION,IBMENU,IBDAM,IBDAO
+8 QUIT
+9 ;
MSET SET IBDAM=$ORDER(^DIC(19,"B",IBMENU,0))
+1 IF 'IBDAM
WRITE !!,"*** Unable to find ",IBMENU,", could not add ",IBOPTION," ***"
QUIT
+2 SET IBDAO=$ORDER(^DIC(19,"B",IBOPTION,0))
+3 IF 'IBDAO
WRITE !!,"*** Unable to find new option ",IBOPTION,", could not add it to ",IBMENU," ***"
QUIT
+4 ;
+5 IF $ORDER(^DIC(19,+IBDAM,10,"B",+IBDAO,0))
WRITE !!,"*** ",IBOPTION," already on ",IBMENU," ***"
QUIT
+6 ;
+7 WRITE !!,">>> Adding ",IBOPTION," option to ",IBMENU
+8 IF '$DATA(^DIC(19,+IBDAM,10,0))
SET ^DIC(19,+IBDAM,10,0)="^19.01IP^0^0"
+9 SET (Y,DA,D0)=+IBDAM
SET DIC="^DIC(19,"_+IBDAM_",10,"
SET DIC(0)="L"
SET DA(1)=+IBDAM
SET DLAYGO=19.01
SET X=IBOPTION
DO ^DIC
+10 SET DA=+Y
SET DIE="^DIC(19,"_DA(1)_",10,"
SET DR="2///"_IBMNU
DO ^DIE
+11 KILL DIC,DIE,DA,DR,D0,DLAYGO,IBDAM,IBDAO,X,Y
+12 QUIT
