BMXPO ; IHS/CMI/MAW - Populate appcontext with all namespaced RPC's ;
;;4.0;BMX;;JUN 28, 2010
;
;
MAIN ;EP - this is the main routine driver
N BMXQFLG
D ASK
I $G(BMXQFLG) D XIT Q
;D CLEAN(BMXAPP)
D POP(BMXAPP,BMXNS)
D XIT
Q
;
GUIEP(RETVAL,BMXSTR) ;EP - gui entry point
N P,BMXAPP,BMXNS
S P="|"
S BMXGUI=1
S BMXAPP=$P(BMXSTR,P)
S BMXNS=$P(BMXSTR,P,2)
K ^BMXTMP($J)
S RETVAL="^BMXTMP("_$J_")"
S ^BMXTMP($J,0)="T00250DATA"_$C(30)
;D CLEAN(BMXAPP)
D POP(BMXAPP,BMXNS)
D XIT
Q
;
ASK ;-- ask the name of the OPTION to populate
W !
S DIC=19,DIC(0)="AEMQZ",DIC("A")="Populate which Application Context: "
D ^DIC
I '$G(Y) S BMXQFLG=1 Q
S BMXAPP=+Y
W !
K DIC
S DIR(0)="F^1:3",DIR("A")="Populate RPC's from which Namespace: "
D ^DIR
I $D(DIRUT) S BMXQFLG=1 Q
S BMXNS=$G(Y)
Q
;
CLEAN(APP) ;-- clean out the RPC multiple first
S DA(1)=APP
S DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
N BMXDA
S BMXDA=0 F S BDMDA=$O(^DIC(19,APP,"RPC",BMXDA)) Q:'BMXDA D
. S DA=BMXDA
. D ^DIK
K ^DIC(19,APP,"RPC","B")
Q
;
POP(APP,NS) ;populate the app context with RPC's
I '$G(BMXGUI) W !,"Populating Application Context"
N BMXDA
S BMXDA=NS
F S BMXDA=$O(^XWB(8994,"B",BMXDA)) Q:BMXDA=""!($E(BMXDA,1,3)'=NS) D
. N BMXIEN
. S BMXIEN=0 F S BMXIEN=$O(^XWB(8994,"B",BMXDA,BMXIEN)) Q:'BMXIEN D
.. Q:$O(^DIC(19,APP,"RPC","B",BMXIEN,0))
.. N BDMIENS,BDMFDA,BDMERR
.. S BDMIENS(1)=APP
.. S BDMIENS="+2,"_APP_","
.. S BDMFDA(19.05,BDMIENS,.01)=BMXIEN
.. D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
.. I '$G(BMXGUI) W "."
Q
;
XIT ;-- clean vars
D EN^XBVK("BMX")
Q
;
BMXPO ; IHS/CMI/MAW - Populate appcontext with all namespaced RPC's ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
MAIN ;EP - this is the main routine driver
+1 NEW BMXQFLG
+2 DO ASK
+3 IF $GET(BMXQFLG)
DO XIT
QUIT
+4 ;D CLEAN(BMXAPP)
+5 DO POP(BMXAPP,BMXNS)
+6 DO XIT
+7 QUIT
+8 ;
GUIEP(RETVAL,BMXSTR) ;EP - gui entry point
+1 NEW P,BMXAPP,BMXNS
+2 SET P="|"
+3 SET BMXGUI=1
+4 SET BMXAPP=$PIECE(BMXSTR,P)
+5 SET BMXNS=$PIECE(BMXSTR,P,2)
+6 KILL ^BMXTMP($JOB)
+7 SET RETVAL="^BMXTMP("_$JOB_")"
+8 SET ^BMXTMP($JOB,0)="T00250DATA"_$CHAR(30)
+9 ;D CLEAN(BMXAPP)
+10 DO POP(BMXAPP,BMXNS)
+11 DO XIT
+12 QUIT
+13 ;
ASK ;-- ask the name of the OPTION to populate
+1 WRITE !
+2 SET DIC=19
SET DIC(0)="AEMQZ"
SET DIC("A")="Populate which Application Context: "
+3 DO ^DIC
+4 IF '$GET(Y)
SET BMXQFLG=1
QUIT
+5 SET BMXAPP=+Y
+6 WRITE !
+7 KILL DIC
+8 SET DIR(0)="F^1:3"
SET DIR("A")="Populate RPC's from which Namespace: "
+9 DO ^DIR
+10 IF $DATA(DIRUT)
SET BMXQFLG=1
QUIT
+11 SET BMXNS=$GET(Y)
+12 QUIT
+13 ;
CLEAN(APP) ;-- clean out the RPC multiple first
+1 SET DA(1)=APP
+2 SET DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
+3 NEW BMXDA
+4 SET BMXDA=0
FOR
SET BDMDA=$ORDER(^DIC(19,APP,"RPC",BMXDA))
IF 'BMXDA
QUIT
Begin DoDot:1
+5 SET DA=BMXDA
+6 DO ^DIK
End DoDot:1
+7 KILL ^DIC(19,APP,"RPC","B")
+8 QUIT
+9 ;
POP(APP,NS) ;populate the app context with RPC's
+1 IF '$GET(BMXGUI)
WRITE !,"Populating Application Context"
+2 NEW BMXDA
+3 SET BMXDA=NS
+4 FOR
SET BMXDA=$ORDER(^XWB(8994,"B",BMXDA))
IF BMXDA=""!($EXTRACT(BMXDA,1,3)'=NS)
QUIT
Begin DoDot:1
+5 NEW BMXIEN
+6 SET BMXIEN=0
FOR
SET BMXIEN=$ORDER(^XWB(8994,"B",BMXDA,BMXIEN))
IF 'BMXIEN
QUIT
Begin DoDot:2
+7 IF $ORDER(^DIC(19,APP,"RPC","B",BMXIEN,0))
QUIT
+8 NEW BDMIENS,BDMFDA,BDMERR
+9 SET BDMIENS(1)=APP
+10 SET BDMIENS="+2,"_APP_","
+11 SET BDMFDA(19.05,BDMIENS,.01)=BMXIEN
+12 DO UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
+13 IF '$GET(BMXGUI)
WRITE "."
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
XIT ;-- clean vars
+1 DO EN^XBVK("BMX")
+2 QUIT
+3 ;
