VENPCCQ7 ; IHS/OIT/GIS - POSTINIT AND VALIDATION ROUTINE: VUECENTRIC COMPONENTS ;
;;2.6;PCC+;**1,4**;APR 03, 2012;Build 24
;
;
VOR(IEN) ; EP - FILTER PCC+ COMPONENTS IN THE VUECENTRIC OBJECT REGISTRY FOR KIDS BUILD ; USED ON SOURCE SERVER
I $G(IEN),$D(^CIAVOBJ(19930.2,IEN,0))
E Q 0
N X,Y,BIEN
S BIEN=$O(^VEN(7.26,"B","PCC+ 2.6",0)) I 'BIEN Q 0
S Y=$P(^CIAVOBJ(19930.2,IEN,0),U)
I $O(^VEN(7.26,BIEN,1,"B",$E(Y,1,30),0)) Q 1
Q 0
;
POSTINIT ; ------------------- EPs FOR POST INIT ------------------------
;
KBM(START,END,ERR) ; EP - GIVEN START AND END IENs, ADD ITEMS TO VEN EHP KB ITEMS FILE FROM THE VEN EHP KB MASTER FILE ; TARGET SERVER
S ERR=1
I $D(^VEN(7.12)),$D(^VEN(7.17)),$D(START),$G(END)
E W !?5,"Knowledgebase file missing! Post init terminated...",!!! Q
N DIC,DIE,DIK,DA,DR,X,Y,Z,%,GBL
S DIK="^VEN(7.12,",GBL=$NA(^VEN(7.12))
I START S DA=START-1
F S DA=$O(^VEN(7.17,DA)) Q:'DA Q:DA>END D
. I '(DA#50) W "."
. K Z
. I $D(@GBL@(DA,0)) D ; REFRESH NODE BUT KEEP CURRENT ACTIVITY STATUS
.. S Z=$P(@GBL@(DA,0),U,11)
.. D ^DIK
.. Q
. M @GBL@(DA)=^VEN(7.17,DA) ; COPY 1 ENTRY
. I $D(Z) S $P(@GBL@(DA,0),U,11)=Z ; SAVE THE PREVIOUS ACTIVE STATUS - IF AVAILABLE
. D IX^DIK ; SET X-REF FOR 1 ENTRY
. Q
S $P(^VEN(7.12,0),U,3,4)=END_U_END
D ^XBFMK
S ERR=0
Q
;
CKVOBJ(BLD,OK) ; EP - CHECK REGISTERED VUECENTRIC OBJECTS ; TARGET SERVER
S OK=0
I $L($G(BLD))
E Q
N A,B,C,D,DS,X,Y,Z,%,PCE,IEN,NM,GBL,IX,STG,DSTG,IXD,DIEN,BIEN,IXX,NAME,DNAME,DNM,TIEN,VGBL,VIEN
S BIEN=$O(^VEN(7.26,"B",BLD,0)) I 'BIEN S OK=1 Q ; BUILD NOT REGISTERED
S GBL=$NA(^CIAVOBJ(19930.2)),VGBL=$NA(^VEN(7.26))
S NM=""
F S NM=$O(@VGBL@(BIEN,1,"B",NM)) Q:NM="" S VIEN=0 F S VIEN=$O(@VGBL@(BIEN,1,"B",NM,VIEN)) Q:'VIEN D ; CHECK OBJECTS AND BUILD THE OBJECT IX ARRAY
. ; S VIEN=$O(@VGBL@(BIEN,1,"B",NM,0)) I 'VIEN Q
. S NAME=$P($G(@VGBL@(BIEN,1,VIEN,0)),U) I NAME="" Q
. S IEN=0
. F S IEN=$O(@GBL@("B",NM,IEN)) Q:'IEN I $P($G(@GBL@(IEN,0)),U)=NAME Q
. I 'IEN D Q
.. I '$D(IXX(NM)) W !?5,"The VueCentric Object '"_NAME_" is missing" S IXX(NM)=""
.. S OK=1
.. Q
. S IX(IEN)=NAME,DNM=""
. F S DNM=$O(@VGBL@(BIEN,1,VIEN,1,"B",DNM)) Q:DNM="" S DIEN=0 F S DIEN=$O(@VGBL@(BIEN,1,VIEN,1,"B",DNM,DIEN)) Q:'DIEN D
.. S DNAME=$P($G(@VGBL@(BIEN,1,VIEN,1,DIEN,0)),U) I DNAME="" Q
.. S TIEN=0
.. F S TIEN=$O(@GBL@("B",DNM,TIEN)) Q:'TIEN I $P($G(@GBL@(TIEN,0)),U)=DNAME Q
.. I 'TIEN D Q
... I '$D(IXX(DNM)) W !?5,"The VueCentric Object '"_NAME_" is missing" S IXX(DNM)=""
... S OK=1
... Q
.. S IX(IEN,TIEN)=DNAME
. Q
S IEN=0
DEP F S IEN=$O(IX(IEN)) Q:'IEN D ; REBUILD THE SUBFILE WITH IEN FROM THE TARGET MACHINE
. I '$O(IX(IEN,0)) Q ; NO DEPENDENCIES
. K @GBL@(IEN,9) ; FIRST CLEAN OUT THE SUBFILE
. S DA(1)=IEN,DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,",(DIC("P"),DLAYGO)=19930.221,DIC(0)="L"
. S TIEN=0
. F S TIEN=$O(IX(IEN,TIEN)) Q:'TIEN D
.. S X="`"_TIEN
.. D ^DIC
.. I Y=-1 S OK=1 W !,"Dependency failure: ",IEN,",",TIEN
.. Q
. Q
I OK W !?7,"Unable to enter all VueCentric Objects and dependencies",! Q
Q
;
HOLD(KEYS,UTYPE) ; EP - ALLOCATE PACKAGE KEYS TO MANAGERS AND USERS ; TARGET SERVER
I $L($G(KEYS)),$L($G(UTYPE))
E Q
N DFN,NAME,X,%,Y,KIEN,KIENS,KEY,Z,STOP,PCE,PRIV,KEYFLAG,STOP,XSTOP
S KEY=$P(KEYS,U),KIENS=""
F PCE=1:1:$L(KEYS,U) D I %="" Q
. S %=$P(KEYS,U,PCE) I %="" Q
. S X=$O(^DIC(19.1,"B",%,0)) I 'X W !?5,"The Security Key ",%," is missing!!!" S %="" Q
. I $L(KIENS) S KIENS=KIENS_U
. S KIENS=KIENS_X
. Q
S KIEN=+KIENS,PRIV=0,KEYFLAG=0,STOP=0
I DUZ(0)'="@",'$D(^VA(200,DUZ,52,KIEN,0)),'$D(^XUSEC("XUMGR",DUZ)),'$D(XUSEC(KEY,DUZ)) ; CURRENT USER HAS KEY ALLOCATION PRIVELEGES
I W !?5,"You currently lack priveleges to distribute keys for this package! Try again later... " Q
LISTHLDR I $O(^XUSEC(KEY,0)) D ; LIST ALL KEY HOLDERS
. S KEYFLAG=1
. S DFN=0 W !?5,"Holders:"
. F S DFN=$O(^XUSEC(KEY,DFN)) Q:'DFN D
.. S NAME=$P($G(^VA(200,DFN,0)),U)
.. I $L(NAME) W !?20,NAME
.. I DFN=DUZ S PRIV=1
.. Q
. Q
I UTYPE="M" D Q:XSTOP G HOLD1
. S XSTOP=1
. I 'KEYFLAG D
.. W !?5,"Currently no site managers or CACs hold the GUI management keys!"
.. W !?5,"Want to assign them to yourself"
.. S %=1 D YN^DICN
.. I %'=1 W !?8,"You must own this key to proceed! Try again later..." Q
.. D ADDKEY(1,KIEN,.STOP) ; ASSIGN KEY TO PRIMARY MANAGER
.. Q
. W !!?2,"Want to assign the GUI Management Keys to IT personnel or CACs"
. S %=2 D YN^DICN
. I %=1 S XSTOP=0
. Q
UKEY I 'KEYFLAG W !!,"Currently no users hold the ",KEY," key"
W !!?2,"Want to assign this key to any other users"
S %=2 D YN^DICN
I %'=1 Q
HOLD1 S STOP=0
F D ADDKEY(0,KIENS,.STOP) I STOP Q ; GET ANOTHER KEYHOLDER
Q
;
ADDKEY(SELF,KIENS,STOP) ; EP - ALLOCATE KEY
N DIC,X,%,DA,DR,DIE,TODAY,SCIEN,KIEN,USER
I SELF S USER=DUZ G AK1 ; SELF-ASSIGNMENT
S DIC=200,DIC(0)="AEQM",DIC("A")="Allocate this key to: "
D ^DIC I Y=-1 S STOP=1 Q
S USER=+Y
S SCIEN=$O(^VA(200,+Y,51,"B",+KIENS,0))
I SCIEN D Q ; THIS USER ALREADY HAS THE KEY
. W !,"This user already holds this key!",!,"Want to de-allocate the key"
. S %=2 D YN^DICN I %'=1 D ^XBFMK Q
. S DA(1)=+Y,DA=SCIEN,DIK="^VA(200,"_DA(1)_",51,"
. D ^DIK,^XBFMK
. W " <- Key de-allocated"
. Q
AK1 ; GIVE ALL OTHER KEYS TO THE RECIPIENT
S DA(1)=USER,DIC="^VA(200,"_DA(1)_",51,",DIC("P")="200.051PA",DIC(0)="L",DLAYGO=200.051
F PCE=1:1:$L(KIENS,U) S KIEN=$P(KIENS,U,PCE) I KIEN D
. S X="`"_KIEN
. D ^DIC I Y=-1 Q
. S DA=+Y,DIE=DIC,DR=".02////^S X=USER;.03////^S X=TODAY"
. L +^VA(200,DA(1)):1 I D ^DIE L -^VA(200,DA(1))
. Q
W " <- Key allocated"
ABP ; ASSIGN BMX BROKER PRIVELEGES TO THE RECIPIENT
N OPT,GBL,IEN,DIC,DIE,DA,DR,DLAYGO,MN,D0
S OPT=$O(^DIC(19,"B","VEN RPC",0)) I 'OPT Q
I $O(^VA(200,USER,203,"B",OPT,0)) Q ; ITS ALREADY IN THERE
S (D0,DA(1))=USER,DIC="^VA(200,"_DA(1)_",203,",DIC(0)="LO"
S (DIC("P"),DLAYGO)=200.03
S X="`"_OPT
D ^DIC I Y=-1 Q
S DA=+Y,DIE=DIC,DR="2////^S X=MN",MN="WRPC"
L +^VA(200,USER,203,DA):1 I D ^DIE L -^VA(200,USER,203,DA)
D ^XBFMK
Q
;
UMO(MIEN,GMIEN) ; EP - ADD VEN_GUIMGR OPTION TO A MENU
I $G(MIEN)
E Q
N GBL,IEN,DIC,DIE,DA,DR,DLAYGO,MN,D0
I $O(^DIC(19,MIEN,10,"B",GMIEN,0)) Q ; ITS ALREADY IN THERE
S (D0,DA(1))=MIEN,DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LO"
S (DIC("P"),DLAYGO)=19.01
S X="`"_GMIEN
D ^DIC I Y=-1 Q
S DA=+Y,DIE=DIC,DR="2////^S X=MN",MN="MPG"
L +^DIC(19,MIEN,10,DA):1 I D ^DIE L -^DIC(19,MIEN,10,DA)
D ^XBFMK
Q
;
CIABMX(OK) ; EP - IF NECESSARY, ADD THE RPC CIABMX TO THE CIAV VUECENTRIC OPTION
N OIEN,RIEN,X,Y,Z,%,DIC,DLAYGO
S RIEN=$O(^XWB(8994,"B","CIABMX",0))
I 'RIEN W !?5,"The RPC 'CIABMX' is missing",! S OK=1 Q
S OIEN=$O(^DIC(19,"B","CIAV VUECENTRIC",0))
I 'OIEN W !?5,"The Option 'CIAV VUECENTRIC' is missing",! S OK=1 Q
S DA(1)=OIEN,DIC="^DIC(19,"_DA(1)_",""RPC"",",(DLAYGO,DIC("P"))=19.05,DIC(0)="L"
S X="`"_RIEN
D ^DIC
I Y=-1 W !?5,"The RPC CIABMX is not registered in broker option CIAV VUECENTRIC" S OK=1 Q
Q
;
PATH(PATH) ; ALERT THE USER OF THE PATH TO THE WCM DLLS
N PIEN,X,Y,Z,%
S PATH=""
S PIEN=$O(^XTV(8989.51,"B","CIAVM DEFAULT SOURCE",0)) I 'PIEN Q
S X=0
F Q:$L(PATH) S X=$O(^XTV(8989.5,X)) Q:'X D
. S %=$P($G(^XTV(8989.5,X,0)),U,2)
. I %'=PIEN Q
. S PATH=$G(^XTV(8989.5,X,1))
. Q
Q
;
DEVEL ; --------------- DEVELOPER UTILITIES -------------------
;
POF ; POPULATE THE VEN OBJECTS FILE
N X,Y,Z,%,DIC,DIE,DA,DR,DLAYGO,NM,DNM,IEN,DIEN,BIEN,XIEN
W !!!,"Enter the VueCentric objects included in this build...",!!
S DIC("A")="Enter build: ",(DIC,DLAYGO)=19707.26,DIC(0)="AEQL"
D ^DIC I Y=-1 Q
S BIEN=+Y
LOOP S DIC("A")="VueCentric object: ",DIC=19930.2,DIC(0)="AEQM"
D ^DIC I Y=-1 G POP
S IEN=+Y,OBJ=$P(Y,U,2),DA=0
F S DA=$O(^VEN(7.26,BIEN,1,"B",$E(OBJ,1,30),DA)) Q:'DA I $P($G(^VEN(7.26,BIEN,1,DA,0)),U)=OBJ D G LOOP
. W !?3,OBJ," is already in the build",!?3,"Want to remove it"
. S %="" D YN^DICN
. I %'=1 Q
. S DA(1)=BIEN,DIK="^VEN(7.26,"_DA(1)_",1,"
. D ^DIK
. Q
S ARR(IEN)=OBJ
S DIEN=0
F S DIEN=$O(^CIAVOBJ(19930.2,IEN,9,"B",DIEN)) Q:'DIEN D
. S DNM=$P($G(^CIAVOBJ(19930.2,DIEN,0)),U) I DNM="" Q
. S ARR(IEN,DIEN)=DNM
. Q
W !! G LOOP
POP I '$O(ARR(0)) Q
S IEN=0
F S IEN=$O(ARR(IEN)) Q:'IEN D
. S DA(1)=BIEN,(DIC("P"),DLAYGO)=19707.261,DIC(0)="LO",DIC="^VEN(7.26,"_DA(1)_",1,"
. S X=ARR(IEN)
. D ^DIC I Y=-1 Q
. S XIEN=+Y,DA(2)=BIEN,DA(1)=XIEN
. S DIC="^VEN(7.26,"_DA(2)_",1,"_DA(1)_",1,",(DIC("P"),DLAYGO)=19707.2611,DIC(0)="LO"
. S DIEN=0
. F S DIEN=$O(ARR(IEN,DIEN)) Q:'DIEN D
.. S X=ARR(IEN,DIEN)
.. D ^DIC
.. Q
. Q
Q
;
AUTODFRM ; AUTOMATE DIFROM SO NO USER INTERVENTION IS NECESSARY
S DIR(0)="F^5:9",DIR("A")="Enter name of any routine in the DIFROM"
D ^DIR
I Y?1"^" Q
I $E(Y)=U S Y=$E(Y,2,99)
S %=$E(Y,$L(Y)-3) I %'="I" W " ??",!! G AUTODFRM
S ROOT=$E(Y,1,$L(Y)-4),DELGBL=""
W !,"Want to delete the data global before running DIFROM"
S %=2 D YN^DICN
I %=1 D I Y=-1 Q
. S DIC("A")="Delete global from what file: "
. S DIC=1,DIC(0)="AEQM"
. D ^DIC I Y=-1 Q
. S %="" W !,"Are you sure you want to delete it"
. D YN^DICN
. I %'=1 Q
. S Z=^DIC(+Y,0,"GL")
. S Z=$E(Z,1,$L(Z)-1)
. S DELGBL=" S %="""_Z_")"" K @%"
. Q
X ("S %=$T(ASK^"_ROOT_"INI1)")
I %="" W !?5,"Can't find the routine ",ROOT,"INI1... Request terminated!" Q
I %["S DSEC=1" W !?5,"Already modified... Request terminated!" Q
S Z=$C($A("Z"))
S LINE="ASK S DSEC=1"_DELGBL
S RT=ROOT_"INI1"
S X="ZL "_RT_" ZR ASK+1 ZR ASK ZI LINE ZS "_RT_" ZL VENPCCQ7"
MD X X
X ("S %=$T(ASK^"_ROOT_"INI1)")
W !?5
I %["S DSEC=1" W "DIFROM modified successfully!" Q
W "Unable to modify DIFROM"
Q
;
ACT ; EP - MANAGE WCM DOMIANS: MAKE THEM ACTIVE OR INCATIVE
N %,%Y,DIR,DIC,DIE,DA,DR,X,Y,Z,%,DIEN,TOT
W !!,"Checking Knowledgebase domains... ",!
K TOT D ACTL
S %=2 W !!,"Want to change the status of any of these elements"
D YN^DICN I %'=1 Q
S DIR("A")="Which element"
ACT1 S DIR(0)="NO^1:"_TOT_":0"
D ^DIR I 'Y Q
S DA=$G(TOT(Y)) I 'DA Q
S DIE="^VEN(7.13,",DR=".07Is this domain active?"
L +^VEN(7.13,DA):1 I D ^DIE L -^VEN(7.13,DA)
D ACTL
S DIR("A")="Another element" W !! G ACT1
;
ACTL ; EP - SHOW IF DOMAIN IS ACTIVE
S DIEN=0,TOT=0
F S DIEN=$O(^VEN(7.13,DIEN)) Q:'DIEN D
. S X=$G(^VEN(7.13,DIEN,0))
. S Y=$P(X,U) I Y'["WELL CHILD" Q
. S Z=$P(X,U,7),TOT=TOT+1,TOT(TOT)=DIEN
. W !?5,TOT,". ",Y," <-",$S(Z'=1:"IN",1:""),"ACTIVE"
. Q
Q
;
VENPCCQ7 ; IHS/OIT/GIS - POSTINIT AND VALIDATION ROUTINE: VUECENTRIC COMPONENTS ;
+1 ;;2.6;PCC+;**1,4**;APR 03, 2012;Build 24
+2 ;
+3 ;
VOR(IEN) ; EP - FILTER PCC+ COMPONENTS IN THE VUECENTRIC OBJECT REGISTRY FOR KIDS BUILD ; USED ON SOURCE SERVER
+1 IF $GET(IEN)
IF $DATA(^CIAVOBJ(19930.2,IEN,0))
+2 IF '$TEST
QUIT 0
+3 NEW X,Y,BIEN
+4 SET BIEN=$ORDER(^VEN(7.26,"B","PCC+ 2.6",0))
IF 'BIEN
QUIT 0
+5 SET Y=$PIECE(^CIAVOBJ(19930.2,IEN,0),U)
+6 IF $ORDER(^VEN(7.26,BIEN,1,"B",$EXTRACT(Y,1,30),0))
QUIT 1
+7 QUIT 0
+8 ;
POSTINIT ; ------------------- EPs FOR POST INIT ------------------------
+1 ;
KBM(START,END,ERR) ; EP - GIVEN START AND END IENs, ADD ITEMS TO VEN EHP KB ITEMS FILE FROM THE VEN EHP KB MASTER FILE ; TARGET SERVER
+1 SET ERR=1
+2 IF $DATA(^VEN(7.12))
IF $DATA(^VEN(7.17))
IF $DATA(START)
IF $GET(END)
+3 IF '$TEST
WRITE !?5,"Knowledgebase file missing! Post init terminated...",!!!
QUIT
+4 NEW DIC,DIE,DIK,DA,DR,X,Y,Z,%,GBL
+5 SET DIK="^VEN(7.12,"
SET GBL=$NAME(^VEN(7.12))
+6 IF START
SET DA=START-1
+7 FOR
SET DA=$ORDER(^VEN(7.17,DA))
IF 'DA
QUIT
IF DA>END
QUIT
Begin DoDot:1
+8 IF '(DA#50)
WRITE "."
+9 KILL Z
+10 ; REFRESH NODE BUT KEEP CURRENT ACTIVITY STATUS
IF $DATA(@GBL@(DA,0))
Begin DoDot:2
+11 SET Z=$PIECE(@GBL@(DA,0),U,11)
+12 DO ^DIK
+13 QUIT
End DoDot:2
+14 ; COPY 1 ENTRY
MERGE @GBL@(DA)=^VEN(7.17,DA)
+15 ; SAVE THE PREVIOUS ACTIVE STATUS - IF AVAILABLE
IF $DATA(Z)
SET $PIECE(@GBL@(DA,0),U,11)=Z
+16 ; SET X-REF FOR 1 ENTRY
DO IX^DIK
+17 QUIT
End DoDot:1
+18 SET $PIECE(^VEN(7.12,0),U,3,4)=END_U_END
+19 DO ^XBFMK
+20 SET ERR=0
+21 QUIT
+22 ;
CKVOBJ(BLD,OK) ; EP - CHECK REGISTERED VUECENTRIC OBJECTS ; TARGET SERVER
+1 SET OK=0
+2 IF $LENGTH($GET(BLD))
+3 IF '$TEST
QUIT
+4 NEW A,B,C,D,DS,X,Y,Z,%,PCE,IEN,NM,GBL,IX,STG,DSTG,IXD,DIEN,BIEN,IXX,NAME,DNAME,DNM,TIEN,VGBL,VIEN
+5 ; BUILD NOT REGISTERED
SET BIEN=$ORDER(^VEN(7.26,"B",BLD,0))
IF 'BIEN
SET OK=1
QUIT
+6 SET GBL=$NAME(^CIAVOBJ(19930.2))
SET VGBL=$NAME(^VEN(7.26))
+7 SET NM=""
+8 ; CHECK OBJECTS AND BUILD THE OBJECT IX ARRAY
FOR
SET NM=$ORDER(@VGBL@(BIEN,1,"B",NM))
IF NM=""
QUIT
SET VIEN=0
FOR
SET VIEN=$ORDER(@VGBL@(BIEN,1,"B",NM,VIEN))
IF 'VIEN
QUIT
Begin DoDot:1
+9 ; S VIEN=$O(@VGBL@(BIEN,1,"B",NM,0)) I 'VIEN Q
+10 SET NAME=$PIECE($GET(@VGBL@(BIEN,1,VIEN,0)),U)
IF NAME=""
QUIT
+11 SET IEN=0
+12 FOR
SET IEN=$ORDER(@GBL@("B",NM,IEN))
IF 'IEN
QUIT
IF $PIECE($GET(@GBL@(IEN,0)),U)=NAME
QUIT
+13 IF 'IEN
Begin DoDot:2
+14 IF '$DATA(IXX(NM))
WRITE !?5,"The VueCentric Object '"_NAME_" is missing"
SET IXX(NM)=""
+15 SET OK=1
+16 QUIT
End DoDot:2
QUIT
+17 SET IX(IEN)=NAME
SET DNM=""
+18 FOR
SET DNM=$ORDER(@VGBL@(BIEN,1,VIEN,1,"B",DNM))
IF DNM=""
QUIT
SET DIEN=0
FOR
SET DIEN=$ORDER(@VGBL@(BIEN,1,VIEN,1,"B",DNM,DIEN))
IF 'DIEN
QUIT
Begin DoDot:2
+19 SET DNAME=$PIECE($GET(@VGBL@(BIEN,1,VIEN,1,DIEN,0)),U)
IF DNAME=""
QUIT
+20 SET TIEN=0
+21 FOR
SET TIEN=$ORDER(@GBL@("B",DNM,TIEN))
IF 'TIEN
QUIT
IF $PIECE($GET(@GBL@(TIEN,0)),U)=DNAME
QUIT
+22 IF 'TIEN
Begin DoDot:3
+23 IF '$DATA(IXX(DNM))
WRITE !?5,"The VueCentric Object '"_NAME_" is missing"
SET IXX(DNM)=""
+24 SET OK=1
+25 QUIT
End DoDot:3
QUIT
+26 SET IX(IEN,TIEN)=DNAME
End DoDot:2
+27 QUIT
End DoDot:1
+28 SET IEN=0
DEP ; REBUILD THE SUBFILE WITH IEN FROM THE TARGET MACHINE
FOR
SET IEN=$ORDER(IX(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+1 ; NO DEPENDENCIES
IF '$ORDER(IX(IEN,0))
QUIT
+2 ; FIRST CLEAN OUT THE SUBFILE
KILL @GBL@(IEN,9)
+3 SET DA(1)=IEN
SET DIC="^CIAVOBJ(19930.2,"_DA(1)_",9,"
SET (DIC("P"),DLAYGO)=19930.221
SET DIC(0)="L"
+4 SET TIEN=0
+5 FOR
SET TIEN=$ORDER(IX(IEN,TIEN))
IF 'TIEN
QUIT
Begin DoDot:2
+6 SET X="`"_TIEN
+7 DO ^DIC
+8 IF Y=-1
SET OK=1
WRITE !,"Dependency failure: ",IEN,",",TIEN
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 IF OK
WRITE !?7,"Unable to enter all VueCentric Objects and dependencies",!
QUIT
+12 QUIT
+13 ;
HOLD(KEYS,UTYPE) ; EP - ALLOCATE PACKAGE KEYS TO MANAGERS AND USERS ; TARGET SERVER
+1 IF $LENGTH($GET(KEYS))
IF $LENGTH($GET(UTYPE))
+2 IF '$TEST
QUIT
+3 NEW DFN,NAME,X,%,Y,KIEN,KIENS,KEY,Z,STOP,PCE,PRIV,KEYFLAG,STOP,XSTOP
+4 SET KEY=$PIECE(KEYS,U)
SET KIENS=""
+5 FOR PCE=1:1:$LENGTH(KEYS,U)
Begin DoDot:1
+6 SET %=$PIECE(KEYS,U,PCE)
IF %=""
QUIT
+7 SET X=$ORDER(^DIC(19.1,"B",%,0))
IF 'X
WRITE !?5,"The Security Key ",%," is missing!!!"
SET %=""
QUIT
+8 IF $LENGTH(KIENS)
SET KIENS=KIENS_U
+9 SET KIENS=KIENS_X
+10 QUIT
End DoDot:1
IF %=""
QUIT
+11 SET KIEN=+KIENS
SET PRIV=0
SET KEYFLAG=0
SET STOP=0
+12 ; CURRENT USER HAS KEY ALLOCATION PRIVELEGES
IF DUZ(0)'="@"
IF '$DATA(^VA(200,DUZ,52,KIEN,0))
IF '$DATA(^XUSEC("XUMGR",DUZ))
IF '$DATA(XUSEC(KEY,DUZ))
+13 IF $TEST
WRITE !?5,"You currently lack priveleges to distribute keys for this package! Try again later... "
QUIT
LISTHLDR ; LIST ALL KEY HOLDERS
IF $ORDER(^XUSEC(KEY,0))
Begin DoDot:1
+1 SET KEYFLAG=1
+2 SET DFN=0
WRITE !?5,"Holders:"
+3 FOR
SET DFN=$ORDER(^XUSEC(KEY,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+4 SET NAME=$PIECE($GET(^VA(200,DFN,0)),U)
+5 IF $LENGTH(NAME)
WRITE !?20,NAME
+6 IF DFN=DUZ
SET PRIV=1
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 IF UTYPE="M"
Begin DoDot:1
+10 SET XSTOP=1
+11 IF 'KEYFLAG
Begin DoDot:2
+12 WRITE !?5,"Currently no site managers or CACs hold the GUI management keys!"
+13 WRITE !?5,"Want to assign them to yourself"
+14 SET %=1
DO YN^DICN
+15 IF %'=1
WRITE !?8,"You must own this key to proceed! Try again later..."
QUIT
+16 ; ASSIGN KEY TO PRIMARY MANAGER
DO ADDKEY(1,KIEN,.STOP)
+17 QUIT
End DoDot:2
+18 WRITE !!?2,"Want to assign the GUI Management Keys to IT personnel or CACs"
+19 SET %=2
DO YN^DICN
+20 IF %=1
SET XSTOP=0
+21 QUIT
End DoDot:1
IF XSTOP
QUIT
GOTO HOLD1
UKEY IF 'KEYFLAG
WRITE !!,"Currently no users hold the ",KEY," key"
+1 WRITE !!?2,"Want to assign this key to any other users"
+2 SET %=2
DO YN^DICN
+3 IF %'=1
QUIT
HOLD1 SET STOP=0
+1 ; GET ANOTHER KEYHOLDER
FOR
DO ADDKEY(0,KIENS,.STOP)
IF STOP
QUIT
+2 QUIT
+3 ;
ADDKEY(SELF,KIENS,STOP) ; EP - ALLOCATE KEY
+1 NEW DIC,X,%,DA,DR,DIE,TODAY,SCIEN,KIEN,USER
+2 ; SELF-ASSIGNMENT
IF SELF
SET USER=DUZ
GOTO AK1
+3 SET DIC=200
SET DIC(0)="AEQM"
SET DIC("A")="Allocate this key to: "
+4 DO ^DIC
IF Y=-1
SET STOP=1
QUIT
+5 SET USER=+Y
+6 SET SCIEN=$ORDER(^VA(200,+Y,51,"B",+KIENS,0))
+7 ; THIS USER ALREADY HAS THE KEY
IF SCIEN
Begin DoDot:1
+8 WRITE !,"This user already holds this key!",!,"Want to de-allocate the key"
+9 SET %=2
DO YN^DICN
IF %'=1
DO ^XBFMK
QUIT
+10 SET DA(1)=+Y
SET DA=SCIEN
SET DIK="^VA(200,"_DA(1)_",51,"
+11 DO ^DIK
DO ^XBFMK
+12 WRITE " <- Key de-allocated"
+13 QUIT
End DoDot:1
QUIT
AK1 ; GIVE ALL OTHER KEYS TO THE RECIPIENT
+1 SET DA(1)=USER
SET DIC="^VA(200,"_DA(1)_",51,"
SET DIC("P")="200.051PA"
SET DIC(0)="L"
SET DLAYGO=200.051
+2 FOR PCE=1:1:$LENGTH(KIENS,U)
SET KIEN=$PIECE(KIENS,U,PCE)
IF KIEN
Begin DoDot:1
+3 SET X="`"_KIEN
+4 DO ^DIC
IF Y=-1
QUIT
+5 SET DA=+Y
SET DIE=DIC
SET DR=".02////^S X=USER;.03////^S X=TODAY"
+6 LOCK +^VA(200,DA(1)):1
IF $TEST
DO ^DIE
LOCK -^VA(200,DA(1))
+7 QUIT
End DoDot:1
+8 WRITE " <- Key allocated"
ABP ; ASSIGN BMX BROKER PRIVELEGES TO THE RECIPIENT
+1 NEW OPT,GBL,IEN,DIC,DIE,DA,DR,DLAYGO,MN,D0
+2 SET OPT=$ORDER(^DIC(19,"B","VEN RPC",0))
IF 'OPT
QUIT
+3 ; ITS ALREADY IN THERE
IF $ORDER(^VA(200,USER,203,"B",OPT,0))
QUIT
+4 SET (D0,DA(1))=USER
SET DIC="^VA(200,"_DA(1)_",203,"
SET DIC(0)="LO"
+5 SET (DIC("P"),DLAYGO)=200.03
+6 SET X="`"_OPT
+7 DO ^DIC
IF Y=-1
QUIT
+8 SET DA=+Y
SET DIE=DIC
SET DR="2////^S X=MN"
SET MN="WRPC"
+9 LOCK +^VA(200,USER,203,DA):1
IF $TEST
DO ^DIE
LOCK -^VA(200,USER,203,DA)
+10 DO ^XBFMK
+11 QUIT
+12 ;
UMO(MIEN,GMIEN) ; EP - ADD VEN_GUIMGR OPTION TO A MENU
+1 IF $GET(MIEN)
+2 IF '$TEST
QUIT
+3 NEW GBL,IEN,DIC,DIE,DA,DR,DLAYGO,MN,D0
+4 ; ITS ALREADY IN THERE
IF $ORDER(^DIC(19,MIEN,10,"B",GMIEN,0))
QUIT
+5 SET (D0,DA(1))=MIEN
SET DIC="^DIC(19,"_DA(1)_",10,"
SET DIC(0)="LO"
+6 SET (DIC("P"),DLAYGO)=19.01
+7 SET X="`"_GMIEN
+8 DO ^DIC
IF Y=-1
QUIT
+9 SET DA=+Y
SET DIE=DIC
SET DR="2////^S X=MN"
SET MN="MPG"
+10 LOCK +^DIC(19,MIEN,10,DA):1
IF $TEST
DO ^DIE
LOCK -^DIC(19,MIEN,10,DA)
+11 DO ^XBFMK
+12 QUIT
+13 ;
CIABMX(OK) ; EP - IF NECESSARY, ADD THE RPC CIABMX TO THE CIAV VUECENTRIC OPTION
+1 NEW OIEN,RIEN,X,Y,Z,%,DIC,DLAYGO
+2 SET RIEN=$ORDER(^XWB(8994,"B","CIABMX",0))
+3 IF 'RIEN
WRITE !?5,"The RPC 'CIABMX' is missing",!
SET OK=1
QUIT
+4 SET OIEN=$ORDER(^DIC(19,"B","CIAV VUECENTRIC",0))
+5 IF 'OIEN
WRITE !?5,"The Option 'CIAV VUECENTRIC' is missing",!
SET OK=1
QUIT
+6 SET DA(1)=OIEN
SET DIC="^DIC(19,"_DA(1)_",""RPC"","
SET (DLAYGO,DIC("P"))=19.05
SET DIC(0)="L"
+7 SET X="`"_RIEN
+8 DO ^DIC
+9 IF Y=-1
WRITE !?5,"The RPC CIABMX is not registered in broker option CIAV VUECENTRIC"
SET OK=1
QUIT
+10 QUIT
+11 ;
PATH(PATH) ; ALERT THE USER OF THE PATH TO THE WCM DLLS
+1 NEW PIEN,X,Y,Z,%
+2 SET PATH=""
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","CIAVM DEFAULT SOURCE",0))
IF 'PIEN
QUIT
+4 SET X=0
+5 FOR
IF $LENGTH(PATH)
QUIT
SET X=$ORDER(^XTV(8989.5,X))
IF 'X
QUIT
Begin DoDot:1
+6 SET %=$PIECE($GET(^XTV(8989.5,X,0)),U,2)
+7 IF %'=PIEN
QUIT
+8 SET PATH=$GET(^XTV(8989.5,X,1))
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
DEVEL ; --------------- DEVELOPER UTILITIES -------------------
+1 ;
POF ; POPULATE THE VEN OBJECTS FILE
+1 NEW X,Y,Z,%,DIC,DIE,DA,DR,DLAYGO,NM,DNM,IEN,DIEN,BIEN,XIEN
+2 WRITE !!!,"Enter the VueCentric objects included in this build...",!!
+3 SET DIC("A")="Enter build: "
SET (DIC,DLAYGO)=19707.26
SET DIC(0)="AEQL"
+4 DO ^DIC
IF Y=-1
QUIT
+5 SET BIEN=+Y
LOOP SET DIC("A")="VueCentric object: "
SET DIC=19930.2
SET DIC(0)="AEQM"
+1 DO ^DIC
IF Y=-1
GOTO POP
+2 SET IEN=+Y
SET OBJ=$PIECE(Y,U,2)
SET DA=0
+3 FOR
SET DA=$ORDER(^VEN(7.26,BIEN,1,"B",$EXTRACT(OBJ,1,30),DA))
IF 'DA
QUIT
IF $PIECE($GET(^VEN(7.26,BIEN,1,DA,0)),U)=OBJ
Begin DoDot:1
+4 WRITE !?3,OBJ," is already in the build",!?3,"Want to remove it"
+5 SET %=""
DO YN^DICN
+6 IF %'=1
QUIT
+7 SET DA(1)=BIEN
SET DIK="^VEN(7.26,"_DA(1)_",1,"
+8 DO ^DIK
+9 QUIT
End DoDot:1
GOTO LOOP
+10 SET ARR(IEN)=OBJ
+11 SET DIEN=0
+12 FOR
SET DIEN=$ORDER(^CIAVOBJ(19930.2,IEN,9,"B",DIEN))
IF 'DIEN
QUIT
Begin DoDot:1
+13 SET DNM=$PIECE($GET(^CIAVOBJ(19930.2,DIEN,0)),U)
IF DNM=""
QUIT
+14 SET ARR(IEN,DIEN)=DNM
+15 QUIT
End DoDot:1
+16 WRITE !!
GOTO LOOP
POP IF '$ORDER(ARR(0))
QUIT
+1 SET IEN=0
+2 FOR
SET IEN=$ORDER(ARR(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+3 SET DA(1)=BIEN
SET (DIC("P"),DLAYGO)=19707.261
SET DIC(0)="LO"
SET DIC="^VEN(7.26,"_DA(1)_",1,"
+4 SET X=ARR(IEN)
+5 DO ^DIC
IF Y=-1
QUIT
+6 SET XIEN=+Y
SET DA(2)=BIEN
SET DA(1)=XIEN
+7 SET DIC="^VEN(7.26,"_DA(2)_",1,"_DA(1)_",1,"
SET (DIC("P"),DLAYGO)=19707.2611
SET DIC(0)="LO"
+8 SET DIEN=0
+9 FOR
SET DIEN=$ORDER(ARR(IEN,DIEN))
IF 'DIEN
QUIT
Begin DoDot:2
+10 SET X=ARR(IEN,DIEN)
+11 DO ^DIC
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
AUTODFRM ; AUTOMATE DIFROM SO NO USER INTERVENTION IS NECESSARY
+1 SET DIR(0)="F^5:9"
SET DIR("A")="Enter name of any routine in the DIFROM"
+2 DO ^DIR
+3 IF Y?1"^"
QUIT
+4 IF $EXTRACT(Y)=U
SET Y=$EXTRACT(Y,2,99)
+5 SET %=$EXTRACT(Y,$LENGTH(Y)-3)
IF %'="I"
WRITE " ??",!!
GOTO AUTODFRM
+6 SET ROOT=$EXTRACT(Y,1,$LENGTH(Y)-4)
SET DELGBL=""
+7 WRITE !,"Want to delete the data global before running DIFROM"
+8 SET %=2
DO YN^DICN
+9 IF %=1
Begin DoDot:1
+10 SET DIC("A")="Delete global from what file: "
+11 SET DIC=1
SET DIC(0)="AEQM"
+12 DO ^DIC
IF Y=-1
QUIT
+13 SET %=""
WRITE !,"Are you sure you want to delete it"
+14 DO YN^DICN
+15 IF %'=1
QUIT
+16 SET Z=^DIC(+Y,0,"GL")
+17 SET Z=$EXTRACT(Z,1,$LENGTH(Z)-1)
+18 SET DELGBL=" S %="""_Z_")"" K @%"
+19 QUIT
End DoDot:1
IF Y=-1
QUIT
+20 XECUTE ("S %=$T(ASK^"_ROOT_"INI1)")
+21 IF %=""
WRITE !?5,"Can't find the routine ",ROOT,"INI1... Request terminated!"
QUIT
+22 IF %["S DSEC=1"
WRITE !?5,"Already modified... Request terminated!"
QUIT
+23 SET Z=$CHAR($ASCII("Z"))
+24 SET LINE="ASK S DSEC=1"_DELGBL
+25 SET RT=ROOT_"INI1"
+26 SET X="ZL "_RT_" ZR ASK+1 ZR ASK ZI LINE ZS "_RT_" ZL VENPCCQ7"
MD XECUTE X
+1 XECUTE ("S %=$T(ASK^"_ROOT_"INI1)")
+2 WRITE !?5
+3 IF %["S DSEC=1"
WRITE "DIFROM modified successfully!"
QUIT
+4 WRITE "Unable to modify DIFROM"
+5 QUIT
+6 ;
ACT ; EP - MANAGE WCM DOMIANS: MAKE THEM ACTIVE OR INCATIVE
+1 NEW %,%Y,DIR,DIC,DIE,DA,DR,X,Y,Z,%,DIEN,TOT
+2 WRITE !!,"Checking Knowledgebase domains... ",!
+3 KILL TOT
DO ACTL
+4 SET %=2
WRITE !!,"Want to change the status of any of these elements"
+5 DO YN^DICN
IF %'=1
QUIT
+6 SET DIR("A")="Which element"
ACT1 SET DIR(0)="NO^1:"_TOT_":0"
+1 DO ^DIR
IF 'Y
QUIT
+2 SET DA=$GET(TOT(Y))
IF 'DA
QUIT
+3 SET DIE="^VEN(7.13,"
SET DR=".07Is this domain active?"
+4 LOCK +^VEN(7.13,DA):1
IF $TEST
DO ^DIE
LOCK -^VEN(7.13,DA)
+5 DO ACTL
+6 SET DIR("A")="Another element"
WRITE !!
GOTO ACT1
+7 ;
ACTL ; EP - SHOW IF DOMAIN IS ACTIVE
+1 SET DIEN=0
SET TOT=0
+2 FOR
SET DIEN=$ORDER(^VEN(7.13,DIEN))
IF 'DIEN
QUIT
Begin DoDot:1
+3 SET X=$GET(^VEN(7.13,DIEN,0))
+4 SET Y=$PIECE(X,U)
IF Y'["WELL CHILD"
QUIT
+5 SET Z=$PIECE(X,U,7)
SET TOT=TOT+1
SET TOT(TOT)=DIEN
+6 WRITE !?5,TOT,". ",Y," <-",$SELECT(Z'=1:"IN",1:""),"ACTIVE"
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
