- 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 ;