Routine: XPARTPV

XPARTPV ;SLC/KCM - Transport package level values

 ;;7.3;TOOLKIT;**26**;Apr 25, 1995

EN ; create transport routines

 W !,"Transport Package Level Parameter Values",!

 N I,PKG,NMSP,ROUNAME,MAXSIZE,NMSP,TODAY,PKGNAME K ^TMP($J)

 S TODAY=$$FMTE^XLFDT($$NOW^XLFDT)

 D PKG^XPARTPV1(.PKG,.PKGNAME,.NMSP) Q:'PKG        ; package & namespace

 D ROU^XPARTPV1(.ROUNAME) Q:ROUNAME=""             ; routine name

 D MAX^XPARTPV1(.MAXSIZE) Q:MAXSIZE=0              ; maximum size

 W !,"Gathering data..."

 D VALTOTMP^XPARTPV1(PKG,NMSP)                     ; put values in ^TMP

 I $O(^TMP($J,"XPARSAVE",0))="" W !,"No data found." Q

 ; create main transport routine

 W !,"Creating ",ROUNAME

 S I=0 F  S X=$T(XX0+I) Q:$P(X," ")="XMAIN"  D

 . I $P(X," ")="XX0" S X=ROUNAME_" ; Export Package Level Parameters ; "_TODAY

 . I $P(X," ")="XX1" S X=" D ^"_ROUNAME_$$MAKEID^XPARTPV1(1)

 . I $P(X," ")="XX2" S $P(X,"_",2)=""""_PKGNAME_""""

 . S I=I+1,^TMP($J,"ROU",ROUNAME,I,0)=X

 ; create data loading routines

 N CURSIZE,ROOT,ROOTEND,ROUCNT,NROUNAM,REF,VAL,X

 S ROUCNT=0,ROOT=$NAME(^TMP($J,"XPARSAVE")),ROOTEND=$L(ROOT)

 D NEWROU S I=8                                ; label DATA is at line 8

 S X=ROOT F  S X=$Q(@X) Q:$E(X,1,ROOTEND-1)_")"'=ROOT  D

 . I (CURSIZE+512)>MAXSIZE D NEWROU S I=8

 . S REF=" ;;"_$E(X,ROOTEND+1,255),VAL=" ;;"_@X

 . S I=I+1,^TMP($J,"ROU",NROUNAM,I,0)=REF

 . S I=I+1,^TMP($J,"ROU",NROUNAM,I,0)=VAL

 . S CURSIZE=CURSIZE+$L(REF)+$L(VAL)

 S ^TMP($J,"ROU",NROUNAM,7,0)=" Q"             ; last rtn:  QUIT, not GO

 ; save routines stored in ^TMP

 D SAVEROU^XPARTPV1

 K ^TMP($J)

NEWROU ; new data loading routine, changes ROUCNT,NROUNAM,CURSIZ

 N I,X

 S ROUCNT=ROUCNT+1,NROUNAM=ROUNAME_$$MAKEID^XPARTPV1(ROUCNT),CURSIZE=0

 W !,"Creating ",NROUNAM

 S I=0 F  S X=$T(XX3+I) Q:$P(X," ")="XLOAD"  D

 . I $P(X," ")="XX3" S X=NROUNAM_" ; ; "_TODAY

 . I $P(X," ")="XX4" S X=" G ^"_ROUNAME_$$MAKEID^XPARTPV1(ROUCNT+1)

 . S I=I+1,^TMP($J,"ROU",NROUNAM,I,0)=X,CURSIZE=CURSIZE+$L(X)

STUB Q

XX0 ; Export Package Level Parameters

;;

MAIN ; main (initial) parameter transport routine

 K ^TMP($J,"XPARRSTR")

 N ENT,IDX,ROOT,REF,VAL,I

 S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","

XX1 D STUB                          ; chains routines that load ^TMP

XX2 S IDX=0,ENT="PKG."_STUB

 F  S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX  D

 . N PAR,INST,VAL,ERR

 . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)

 . M VAL=^TMP($J,"XPARRSTR",IDX,"VAL")

 . D EN^XPAR(ENT,PAR,INST,.VAL,.ERR)

 K ^TMP($J,"XPARRSTR")

XMAIN ;; end of MAIN

XX3 ; Export Package Level Parameters

;;

LOAD ; load data into ^TMP (expects ROOT to be defined)

 S I=1 F  S REF=$T(DATA+I) Q:REF=""  S VAL=$T(DATA+I+1) D

 . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)

 . S @(ROOT_REF)=VAL

XX4 G STUB

DATA ; parameter data

XLOAD ;; end of LOAD

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPARTPV   2928     printed  Feb 19, 2025@00:06:51                                                                                                                                                                                                     Page 2

XPARTPV   ;SLC/KCM - Transport package level values

 +1       ;;7.3;TOOLKIT;**26**;Apr 25, 1995

 +2       ;

EN        ; create transport routines

 +1        WRITE !,"Transport Package Level Parameter Values",!

 +2        NEW I,PKG,NMSP,ROUNAME,MAXSIZE,NMSP,TODAY,PKGNAME

           KILL ^TMP($JOB)

 +3        SET TODAY=$$FMTE^XLFDT($$NOW^XLFDT)

 +4       ; package & namespace

           DO PKG^XPARTPV1(.PKG,.PKGNAME,.NMSP)

           if 'PKG

               QUIT

 +5       ; routine name

           DO ROU^XPARTPV1(.ROUNAME)

           if ROUNAME=""

               QUIT

 +6       ; maximum size

           DO MAX^XPARTPV1(.MAXSIZE)

           if MAXSIZE=0

               QUIT

 +7        WRITE !,"Gathering data..."

 +8       ; put values in ^TMP

           DO VALTOTMP^XPARTPV1(PKG,NMSP)

 +9        IF $ORDER(^TMP($JOB,"XPARSAVE",0))=""

               WRITE !,"No data found."

               QUIT

 +10      ;

 +11      ; create main transport routine

 +12       WRITE !,"Creating ",ROUNAME

 +13       SET I=0

FOR

               SET X=$TEXT(XX0+I)

               if $PIECE(X," ")="XMAIN"

                   QUIT

               Begin DoDot:1

 +14               IF $PIECE(X," ")="XX0"

                       SET X=ROUNAME_" ; Export Package Level Parameters ; "_TODAY

 +15               IF $PIECE(X," ")="XX1"

                       SET X=" D ^"_ROUNAME_$$MAKEID^XPARTPV1(1)

 +16               IF $PIECE(X," ")="XX2"

                       SET $PIECE(X,"_",2)=""""_PKGNAME_""""

 +17               SET I=I+1

                   SET ^TMP($JOB,"ROU",ROUNAME,I,0)=X

               End DoDot:1

 +18      ;

 +19      ; create data loading routines

 +20       NEW CURSIZE,ROOT,ROOTEND,ROUCNT,NROUNAM,REF,VAL,X

 +21       SET ROUCNT=0

           SET ROOT=$NAME(^TMP($JOB,"XPARSAVE"))

           SET ROOTEND=$LENGTH(ROOT)

 +22      ; label DATA is at line 8

           DO NEWROU

           SET I=8

 +23       SET X=ROOT

FOR

               SET X=$QUERY(@X)

               if $EXTRACT(X,1,ROOTEND-1)_")"'=ROOT

                   QUIT

               Begin DoDot:1

 +24               IF (CURSIZE+512)>MAXSIZE

                       DO NEWROU

                       SET I=8

 +25               SET REF=" ;;"_$EXTRACT(X,ROOTEND+1,255)

                   SET VAL=" ;;"_@X

 +26               SET I=I+1

                   SET ^TMP($JOB,"ROU",NROUNAM,I,0)=REF

 +27               SET I=I+1

                   SET ^TMP($JOB,"ROU",NROUNAM,I,0)=VAL

 +28               SET CURSIZE=CURSIZE+$LENGTH(REF)+$LENGTH(VAL)

               End DoDot:1

 +29      ; last rtn:  QUIT, not GO

           SET ^TMP($JOB,"ROU",NROUNAM,7,0)=" Q"

 +30      ;

 +31      ; save routines stored in ^TMP

 +32       DO SAVEROU^XPARTPV1

 +33       KILL ^TMP($JOB)

 +34       QUIT

NEWROU    ; new data loading routine, changes ROUCNT,NROUNAM,CURSIZ

 +1        NEW I,X

 +2        SET ROUCNT=ROUCNT+1

           SET NROUNAM=ROUNAME_$$MAKEID^XPARTPV1(ROUCNT)

           SET CURSIZE=0

 +3        WRITE !,"Creating ",NROUNAM

 +4        SET I=0

FOR

               SET X=$TEXT(XX3+I)

               if $PIECE(X," ")="XLOAD"

                   QUIT

               Begin DoDot:1

 +5                IF $PIECE(X," ")="XX3"

                       SET X=NROUNAM_" ; ; "_TODAY

 +6                IF $PIECE(X," ")="XX4"

                       SET X=" G ^"_ROUNAME_$$MAKEID^XPARTPV1(ROUCNT+1)

 +7                SET I=I+1

                   SET ^TMP($JOB,"ROU",NROUNAM,I,0)=X

                   SET CURSIZE=CURSIZE+$LENGTH(X)

               End DoDot:1

 +8        QUIT

 +9       ;

STUB       QUIT

 +1       ;

XX0       ; Export Package Level Parameters

 +1       ;;

MAIN      ; main (initial) parameter transport routine

 +1        KILL ^TMP($JOB,"XPARRSTR")

 +2        NEW ENT,IDX,ROOT,REF,VAL,I

 +3        SET ROOT=$NAME(^TMP($JOB,"XPARRSTR"))

           SET ROOT=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)_","

XX1       ; chains routines that load ^TMP

           DO STUB

XX2        SET IDX=0

           SET ENT="PKG."_STUB

 +1        FOR

               SET IDX=$ORDER(^TMP($JOB,"XPARRSTR",IDX))

               if 'IDX

                   QUIT

               Begin DoDot:1

 +2                NEW PAR,INST,VAL,ERR

 +3                SET PAR=$PIECE(^TMP($JOB,"XPARRSTR",IDX,"KEY"),U)

                   SET INST=$PIECE(^("KEY"),U,2)

 +4                MERGE VAL=^TMP($JOB,"XPARRSTR",IDX,"VAL")

 +5                DO EN^XPAR(ENT,PAR,INST,.VAL,.ERR)

               End DoDot:1

 +6        KILL ^TMP($JOB,"XPARRSTR")

 +7        QUIT

XMAIN     ;; end of MAIN

 +1       ;

XX3       ; Export Package Level Parameters

 +1       ;;

LOAD      ; load data into ^TMP (expects ROOT to be defined)

 +1        SET I=1

FOR

               SET REF=$TEXT(DATA+I)

               if REF=""

                   QUIT

               SET VAL=$TEXT(DATA+I+1)

               Begin DoDot:1

 +2                SET I=I+2

                   SET REF=$PIECE(REF,";",3,999)

                   SET VAL=$PIECE(VAL,";",3,999)

 +3                SET @(ROOT_REF)=VAL

               End DoDot:1

XX4        GOTO STUB

DATA      ; parameter data

XLOAD     ;; end of LOAD

XPARTPV.m