Routine: AMHPAR

AMHPAR ; IHS/CMI/LAB - Export Package Level Parameters Mar 03, 2006@10:07:20 ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

;;

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)_","

 D ^AMHPAR01

XX2 S IDX=0,ENT="PKG."_"IHS MENTAL HLTH/SOC SERV"

 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")

AMHPAR    ; IHS/CMI/LAB - Export Package Level Parameters Mar 03, 2006@10:07:20 ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;;

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)_","

 +4        DO ^AMHPAR01

XX2        SET IDX=0

           SET ENT="PKG."_"IHS MENTAL HLTH/SOC SERV"

 +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

AMHPAR.m