| [613] | 1 | XPARTPV ;SLC/KCM - Transport package level values
|
|---|
| 2 | ;;7.3;TOOLKIT;**26**;Apr 25, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; create transport routines
|
|---|
| 5 | W !,"Transport Package Level Parameter Values",!
|
|---|
| 6 | N I,PKG,NMSP,ROUNAME,MAXSIZE,NMSP,TODAY,PKGNAME K ^TMP($J)
|
|---|
| 7 | S TODAY=$$FMTE^XLFDT($$NOW^XLFDT)
|
|---|
| 8 | D PKG^XPARTPV1(.PKG,.PKGNAME,.NMSP) Q:'PKG ; package & namespace
|
|---|
| 9 | D ROU^XPARTPV1(.ROUNAME) Q:ROUNAME="" ; routine name
|
|---|
| 10 | D MAX^XPARTPV1(.MAXSIZE) Q:MAXSIZE=0 ; maximum size
|
|---|
| 11 | W !,"Gathering data..."
|
|---|
| 12 | D VALTOTMP^XPARTPV1(PKG,NMSP) ; put values in ^TMP
|
|---|
| 13 | I $O(^TMP($J,"XPARSAVE",0))="" W !,"No data found." Q
|
|---|
| 14 | ;
|
|---|
| 15 | ; create main transport routine
|
|---|
| 16 | W !,"Creating ",ROUNAME
|
|---|
| 17 | S I=0 F S X=$T(XX0+I) Q:$P(X," ")="XMAIN" D
|
|---|
| 18 | . I $P(X," ")="XX0" S X=ROUNAME_" ; Export Package Level Parameters ; "_TODAY
|
|---|
| 19 | . I $P(X," ")="XX1" S X=" D ^"_ROUNAME_$$MAKEID^XPARTPV1(1)
|
|---|
| 20 | . I $P(X," ")="XX2" S $P(X,"_",2)=""""_PKGNAME_""""
|
|---|
| 21 | . S I=I+1,^TMP($J,"ROU",ROUNAME,I,0)=X
|
|---|
| 22 | ;
|
|---|
| 23 | ; create data loading routines
|
|---|
| 24 | N CURSIZE,ROOT,ROOTEND,ROUCNT,NROUNAM,REF,VAL,X
|
|---|
| 25 | S ROUCNT=0,ROOT=$NAME(^TMP($J,"XPARSAVE")),ROOTEND=$L(ROOT)
|
|---|
| 26 | D NEWROU S I=8 ; label DATA is at line 8
|
|---|
| 27 | S X=ROOT F S X=$Q(@X) Q:$E(X,1,ROOTEND-1)_")"'=ROOT D
|
|---|
| 28 | . I (CURSIZE+512)>MAXSIZE D NEWROU S I=8
|
|---|
| 29 | . S REF=" ;;"_$E(X,ROOTEND+1,255),VAL=" ;;"_@X
|
|---|
| 30 | . S I=I+1,^TMP($J,"ROU",NROUNAM,I,0)=REF
|
|---|
| 31 | . S I=I+1,^TMP($J,"ROU",NROUNAM,I,0)=VAL
|
|---|
| 32 | . S CURSIZE=CURSIZE+$L(REF)+$L(VAL)
|
|---|
| 33 | S ^TMP($J,"ROU",NROUNAM,7,0)=" Q" ; last rtn: QUIT, not GO
|
|---|
| 34 | ;
|
|---|
| 35 | ; save routines stored in ^TMP
|
|---|
| 36 | D SAVEROU^XPARTPV1
|
|---|
| 37 | K ^TMP($J)
|
|---|
| 38 | Q
|
|---|
| 39 | NEWROU ; new data loading routine, changes ROUCNT,NROUNAM,CURSIZ
|
|---|
| 40 | N I,X
|
|---|
| 41 | S ROUCNT=ROUCNT+1,NROUNAM=ROUNAME_$$MAKEID^XPARTPV1(ROUCNT),CURSIZE=0
|
|---|
| 42 | W !,"Creating ",NROUNAM
|
|---|
| 43 | S I=0 F S X=$T(XX3+I) Q:$P(X," ")="XLOAD" D
|
|---|
| 44 | . I $P(X," ")="XX3" S X=NROUNAM_" ; ; "_TODAY
|
|---|
| 45 | . I $P(X," ")="XX4" S X=" G ^"_ROUNAME_$$MAKEID^XPARTPV1(ROUCNT+1)
|
|---|
| 46 | . S I=I+1,^TMP($J,"ROU",NROUNAM,I,0)=X,CURSIZE=CURSIZE+$L(X)
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | STUB Q
|
|---|
| 50 | ;
|
|---|
| 51 | XX0 ; Export Package Level Parameters
|
|---|
| 52 | ;;
|
|---|
| 53 | MAIN ; main (initial) parameter transport routine
|
|---|
| 54 | K ^TMP($J,"XPARRSTR")
|
|---|
| 55 | N ENT,IDX,ROOT,REF,VAL,I
|
|---|
| 56 | S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","
|
|---|
| 57 | XX1 D STUB ; chains routines that load ^TMP
|
|---|
| 58 | XX2 S IDX=0,ENT="PKG."_STUB
|
|---|
| 59 | F S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX D
|
|---|
| 60 | . N PAR,INST,VAL,ERR
|
|---|
| 61 | . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
|
|---|
| 62 | . M VAL=^TMP($J,"XPARRSTR",IDX,"VAL")
|
|---|
| 63 | . D EN^XPAR(ENT,PAR,INST,.VAL,.ERR)
|
|---|
| 64 | K ^TMP($J,"XPARRSTR")
|
|---|
| 65 | Q
|
|---|
| 66 | XMAIN ;; end of MAIN
|
|---|
| 67 | ;
|
|---|
| 68 | XX3 ; Export Package Level Parameters
|
|---|
| 69 | ;;
|
|---|
| 70 | LOAD ; load data into ^TMP (expects ROOT to be defined)
|
|---|
| 71 | S I=1 F S REF=$T(DATA+I) Q:REF="" S VAL=$T(DATA+I+1) D
|
|---|
| 72 | . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
|
|---|
| 73 | . S @(ROOT_REF)=VAL
|
|---|
| 74 | XX4 G STUB
|
|---|
| 75 | DATA ; parameter data
|
|---|
| 76 | XLOAD ;; end of LOAD
|
|---|
