Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPARTPV1

XPARTPV1.m

Go to the documentation of this file.
XPARTPV1 ;SLC/KCM - Transport, supporting calls
 ;;7.3;TOOLKIT;**26**;Apr 25, 1995
 ;
ZPKG(IEN,NAME) ; get package IEN & Name
 N DIC,X,Y
 S IEN=0,NAME=""
 S DIC=9.4,DIC(0)="AEMQ" D ^DIC Q:Y<1
 S IEN=+Y_";DIC(9.4,",NAME=$P(Y,U,2)
 Q
PKG(IEN,NAME,NMSP) ; get namespace and associated package
 N DIR,DIRUT,DTOUT,DUOUT,PKG
 S IEN=0,NAME="",NMSP=""
 S DIR("A")="Parameter Namespace",DIR(0)="F^2:30"
 D ^DIR Q:$D(DIRUT)  S NMSP=$P(Y,"*")
 I $D(^DIC(9.4,"C",NMSP)) S IEN=$O(^DIC(9.4,"C",NMSP,0))
 E  S PKG=NMSP D
 . F  S PKG=$O(^DIC(9.4,"C",PKG),-1) Q:$E(NMSP,1,$L(PKG))=PKG
 . I $L(PKG) S IEN=$O(^DIC(9.4,"C",PKG,0))
 I IEN S NAME=$P(^DIC(9.4,IEN,0),U),IEN=IEN_";DIC(9.4,"
 Q
ROU(NAME) ; get routine name
 N DIR,DIRUT,DTOUT,DUOUT
 S NAME=""
 S DIR("A")="Routine Name",DIR(0)="F^2:6"
 D ^DIR Q:$D(DIRUT)  S NAME=Y
 W !!,"This will create a series of ",NAME," routines."
 I $T(@(U_NAME))'="" W !,"But "_NAME_" already exists!"
 S DIR("A")="Is that ok",DIR(0)="Y"
 D ^DIR I $D(DIRUT)!(Y=0) S NAME=""
 Q
MAX(SIZ) ; get maximum routine size
 N DIR,DIRUT,DTOUT,DUOUT
 S SIZ=0
 S DIR("A")="Maximum Routine Size",DIR(0)="N^2000:8000"
 D ^DIR Q:$D(DIRUT)  S SIZ=Y
 Q
VALTOTMP(PKG,NMSP) ; gather package level parameter values & put in ^TMP
 N I,CNT K ^TMP($J,"XPARSAVE")
 S (I,CNT)=0 F  S I=$O(^XTV(8989.5,"B",PKG,I)) Q:'I  D
 . N PAR,PARNAME,INST,VAL,X
 . S X=^XTV(8989.5,I,0),PAR=$P(X,U,2),INST=$P(X,U,3),VAL=^(1)
 . S PARNAME=$P(^XTV(8989.51,PAR,0),U,1)
 . I $E(PARNAME,1,$L(NMSP))'=NMSP Q  ; skip if outside namespace
 . S INST=$$EXT^XPARDD(INST,PAR,"I"),VAL=$$EXT^XPARDD(VAL,PAR,"V")
 . I $D(^XTV(8989.5,I,2))>9 M VAL=^(2) K VAL(0)
 . S ^TMP($J,"XPARSAVE",I,"KEY")=PARNAME_U_INST
 . M ^TMP($J,"XPARSAVE",I,"VAL")=VAL
 . S CNT=CNT+1 I CNT#100=0 W "."
 Q
SAVEROU ; loop thru ^TMP($J,"ROU") and save routines
 N DIE,X,XCM,XCN
 S X="" F  S X=$O(^TMP($J,"ROU",X)) Q:X=""  D
 . W !,"Saving ",X
 . S DIE="^TMP($J,""ROU"","""_X_""",",XCN=0
 . X ^%ZOSF("SAVE")
 Q
MAKEID(I) ; return two char ID based on integer, (0..9,A..Z)=base 36
 Q $TR($C(I\36+55)_$C(I#36+55),"789:;<=>?@","0123456789")