CIAVUTPR.m

CIAVUTPR ;MSC/IND/DKM - Parameter management ;04-May-2006 08:19;DKM

 ;;1.1V2;VUECENTRIC FRAMEWORK;;Mar 20, 2007

 ;;Copyright 2000-2006, Medsphere Systems Corporation

 ;=================================================================

 ; Load a parameter template

GETTPL(DATA,TPL) ;

 N PAR,SEQ,CNT,LP,X0,X1

 S:TPL'=+TPL TPL=+$$FIND1^DIC(8989.52,,,TPL)

 I '$D(^XTV(8989.52,TPL,0)) S DATA(1)="-1^Not found" Q

 S CNT=1,SEQ="",X0=^XTV(8989.52,TPL,0),X1=+$P(X0,U,3)

 S X1=$S(X1=4:"DIV",X1=4.2:"SYS",X1=9.4:"PKG",X1=49:"SRV",X1=200:"USR",1:"")

 I '$L(X1) S DATA(1)="-2^Bad entity" Q

 S $P(X0,U,3)=X1,DATA(1)=TPL_U_X0

 F  S SEQ=$O(^XTV(8989.52,TPL,10,"B",SEQ)),LP=0 Q:'$L(SEQ)  D

 .F  S LP=$O(^XTV(8989.52,TPL,10,"B",SEQ,LP)) Q:'LP  D

 ..S PAR=+$P($G(^XTV(8989.52,TPL,10,LP,0)),U,2)

 ..S X0=$G(^XTV(8989.51,PAR,0)),X1=$G(^(1))

 ..S:$L(X0) CNT=CNT+1,DATA(CNT)=PAR_U_$P(X0,U)_U_$P(X0,U,2)_U_X1

 Q

CIAVUTPR  ;MSC/IND/DKM - Parameter management ;04-May-2006 08:19;DKM

 +1       ;;1.1V2;VUECENTRIC FRAMEWORK;;Mar 20, 2007

 +2       ;;Copyright 2000-2006, Medsphere Systems Corporation

 +3       ;=================================================================

 +4       ; Load a parameter template

GETTPL(DATA,TPL) ;

 +1        NEW PAR,SEQ,CNT,LP,X0,X1

 +2        IF TPL'=+TPL

               SET TPL=+$$FIND1^DIC(8989.52,,,TPL)

 +3        IF '$DATA(^XTV(8989.52,TPL,0))

               SET DATA(1)="-1^Not found"

               QUIT 

 +4        SET CNT=1

           SET SEQ=""

           SET X0=^XTV(8989.52,TPL,0)

           SET X1=+$PIECE(X0,U,3)

 +5        SET X1=$SELECT(X1=4:"DIV",X1=4.2:"SYS",X1=9.4:"PKG",X1=49:"SRV",X1=200:"USR",1:"")

 +6        IF '$LENGTH(X1)

               SET DATA(1)="-2^Bad entity"

               QUIT 

 +7        SET $PIECE(X0,U,3)=X1

           SET DATA(1)=TPL_U_X0

 +8        FOR 

               SET SEQ=$ORDER(^XTV(8989.52,TPL,10,"B",SEQ))

               SET LP=0

               IF '$LENGTH(SEQ)

                   QUIT 

               Begin DoDot:1

 +9                FOR 

                       SET LP=$ORDER(^XTV(8989.52,TPL,10,"B",SEQ,LP))

                       IF 'LP

                           QUIT 

                       Begin DoDot:2

 +10                       SET PAR=+$PIECE($GET(^XTV(8989.52,TPL,10,LP,0)),U,2)

 +11                       SET X0=$GET(^XTV(8989.51,PAR,0))

                           SET X1=$GET(^(1))

 +12                       IF $LENGTH(X0)

                               SET CNT=CNT+1

                               SET DATA(CNT)=PAR_U_$PIECE(X0,U)_U_$PIECE(X0,U,2)_U_X1

                       End DoDot:2

               End DoDot:1

 +13       QUIT