| 1 | XPARTPV1 ;SLC/KCM - Transport, supporting calls
|
|---|
| 2 | ;;7.3;TOOLKIT;**26**;Apr 25, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ZPKG(IEN,NAME) ; get package IEN & Name
|
|---|
| 5 | N DIC,X,Y
|
|---|
| 6 | S IEN=0,NAME=""
|
|---|
| 7 | S DIC=9.4,DIC(0)="AEMQ" D ^DIC Q:Y<1
|
|---|
| 8 | S IEN=+Y_";DIC(9.4,",NAME=$P(Y,U,2)
|
|---|
| 9 | Q
|
|---|
| 10 | PKG(IEN,NAME,NMSP) ; get namespace and associated package
|
|---|
| 11 | N DIR,DIRUT,DTOUT,DUOUT,PKG
|
|---|
| 12 | S IEN=0,NAME="",NMSP=""
|
|---|
| 13 | S DIR("A")="Parameter Namespace",DIR(0)="F^2:30"
|
|---|
| 14 | D ^DIR Q:$D(DIRUT) S NMSP=$P(Y,"*")
|
|---|
| 15 | I $D(^DIC(9.4,"C",NMSP)) S IEN=$O(^DIC(9.4,"C",NMSP,0))
|
|---|
| 16 | E S PKG=NMSP D
|
|---|
| 17 | . F S PKG=$O(^DIC(9.4,"C",PKG),-1) Q:$E(NMSP,1,$L(PKG))=PKG
|
|---|
| 18 | . I $L(PKG) S IEN=$O(^DIC(9.4,"C",PKG,0))
|
|---|
| 19 | I IEN S NAME=$P(^DIC(9.4,IEN,0),U),IEN=IEN_";DIC(9.4,"
|
|---|
| 20 | Q
|
|---|
| 21 | ROU(NAME) ; get routine name
|
|---|
| 22 | N DIR,DIRUT,DTOUT,DUOUT
|
|---|
| 23 | S NAME=""
|
|---|
| 24 | S DIR("A")="Routine Name",DIR(0)="F^2:6"
|
|---|
| 25 | D ^DIR Q:$D(DIRUT) S NAME=Y
|
|---|
| 26 | W !!,"This will create a series of ",NAME," routines."
|
|---|
| 27 | I $T(@(U_NAME))'="" W !,"But "_NAME_" already exists!"
|
|---|
| 28 | S DIR("A")="Is that ok",DIR(0)="Y"
|
|---|
| 29 | D ^DIR I $D(DIRUT)!(Y=0) S NAME=""
|
|---|
| 30 | Q
|
|---|
| 31 | MAX(SIZ) ; get maximum routine size
|
|---|
| 32 | N DIR,DIRUT,DTOUT,DUOUT
|
|---|
| 33 | S SIZ=0
|
|---|
| 34 | S DIR("A")="Maximum Routine Size",DIR(0)="N^2000:8000"
|
|---|
| 35 | D ^DIR Q:$D(DIRUT) S SIZ=Y
|
|---|
| 36 | Q
|
|---|
| 37 | VALTOTMP(PKG,NMSP) ; gather package level parameter values & put in ^TMP
|
|---|
| 38 | N I,CNT K ^TMP($J,"XPARSAVE")
|
|---|
| 39 | S (I,CNT)=0 F S I=$O(^XTV(8989.5,"B",PKG,I)) Q:'I D
|
|---|
| 40 | . N PAR,PARNAME,INST,VAL,X
|
|---|
| 41 | . S X=^XTV(8989.5,I,0),PAR=$P(X,U,2),INST=$P(X,U,3),VAL=^(1)
|
|---|
| 42 | . S PARNAME=$P(^XTV(8989.51,PAR,0),U,1)
|
|---|
| 43 | . I $E(PARNAME,1,$L(NMSP))'=NMSP Q ; skip if outside namespace
|
|---|
| 44 | . S INST=$$EXT^XPARDD(INST,PAR,"I"),VAL=$$EXT^XPARDD(VAL,PAR,"V")
|
|---|
| 45 | . I $D(^XTV(8989.5,I,2))>9 M VAL=^(2) K VAL(0)
|
|---|
| 46 | . S ^TMP($J,"XPARSAVE",I,"KEY")=PARNAME_U_INST
|
|---|
| 47 | . M ^TMP($J,"XPARSAVE",I,"VAL")=VAL
|
|---|
| 48 | . S CNT=CNT+1 I CNT#100=0 W "."
|
|---|
| 49 | Q
|
|---|
| 50 | SAVEROU ; loop thru ^TMP($J,"ROU") and save routines
|
|---|
| 51 | N DIE,X,XCM,XCN
|
|---|
| 52 | S X="" F S X=$O(^TMP($J,"ROU",X)) Q:X="" D
|
|---|
| 53 | . W !,"Saving ",X
|
|---|
| 54 | . S DIE="^TMP($J,""ROU"","""_X_""",",XCN=0
|
|---|
| 55 | . X ^%ZOSF("SAVE")
|
|---|
| 56 | Q
|
|---|
| 57 | MAKEID(I) ; return two char ID based on integer, (0..9,A..Z)=base 36
|
|---|
| 58 | Q $TR($C(I\36+55)_$C(I#36+55),"789:;<=>?@","0123456789")
|
|---|
