source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XPARTPV.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1XPARTPV ;SLC/KCM - Transport package level values
2 ;;7.3;TOOLKIT;**26**;Apr 25, 1995
3 ;
4EN ; 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
39NEWROU ; 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 ;
49STUB Q
50 ;
51XX0 ; Export Package Level Parameters
52 ;;
53MAIN ; 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)_","
57XX1 D STUB ; chains routines that load ^TMP
58XX2 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
66XMAIN ;; end of MAIN
67 ;
68XX3 ; Export Package Level Parameters
69 ;;
70LOAD ; 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
74XX4 G STUB
75DATA ; parameter data
76XLOAD ;; end of LOAD
Note: See TracBrowser for help on using the repository browser.