AMQQGTX0.m

AMQQGTX0(X,AMQQGTX,Y) ; IHS/CMI/THL - PROGRAMMER CALL TO CREATE TAXONOMIES AND/OR HAVE ARRAYS OF VALUES RETURNED ; [ 03/03/2009  9:28 AM ]

 ;;2.0;IHS PCC SUITE;;MAR 3, 2009

 ;-----

 ;FIRST LINE PARAMETER PASS OKAY'ED BY SAC COMMITTEE TO ALLOW OTHER PACKAGES TO CHANGE THEIR CALLS

 ;

EN ; - ENTRY POINT - Generation of taxonomy by end user

 ; X=dfn attribute in QMAN DICTIONARY OF TERMS file

 ; AMQQGTX=array for values to passed back in 

 ; Y=dfn of the Taxonomy

 I $G(Y),$G(AMQQGTX)]"" D TAX Q

 I '$D(X)!'$D(AMQQGTX) W !,"Required variables not passed" Q

 I '$P($G(^AMQQ(5,X,0)),U,14) W !,"Unacceptable QMAN term.  Taxonomy creation not allowed!" Q

 S AMQQATNM=$P(^AMQQ(5,X,0),U)

 D EN1^AMQQTX

EN1 I $D(^UTILITY("AMQQ TAX",$J)) S %=0  F  S %=$O(^UTILITY("AMQQ TAX",$J,1,%)) Q:%=""  S @(AMQQGTX_""""_%_""")")=""

 K AMQQCCLS,AMQQMULT,AMQQQUIT,AMQQCNAM,AMQQQ,AMQQURGN,DR,DIE,AMQQDF,^UTILITY("AMQQ TAX",$J),AMQQGTX,AMQQATNM

 Q

 ;

PEP(X,AMQQGTX,Y) ; - PUBLISHED ENTRY POINT - Generation of taxonomy by end user

 D EN

 Q

TAX ;EVALUATE TAXONOMY

 K ^UTILITY("AMQQ TAX",$J)

 Q:'$D(^ATXAX(+Y,0))  S %=^(0)

 S AMQQLINK=$P(%,U,12)

 S AMQQTLOK=$P(%,U,15)

 Q:'AMQQLINK!'AMQQTLOK

 N J,K,L

 S J=0

 F  S J=$O(^AMQQ(5,J)) Q:'J!(J>999)  S K=^(J,0),L=$P(K,U,14),K=$P(K,U,5) S:K=AMQQLINK&L M(K,L)=""

 S AMQQTAXT=$O(M(AMQQLINK,0))

 Q:'AMQQTAXT

 S AMQQHILO="^UTILITY(""AMQQ"",$J,""HILO"")"

 S:'$G(AMQQURGN) AMQQURGN=1

 S AMQQTLOK=$G(^DIC(+AMQQTLOK,0,"GL"))

 I AMQQTLOK["," S AMQQTGBL=$P(AMQQTLOK,",")_")"

 E  S AMQQTGBL=$P(AMQQTLOK,"(")

 Q:$G(AMQQTGBL)=""

 N AMQQXX

 S AMQQXX=""

 D REST^AMQQTX0

 D EN1

 Q

AMQQGTX0(X,AMQQGTX,Y) ; IHS/CMI/THL - PROGRAMMER CALL TO CREATE TAXONOMIES AND/OR HAVE ARRAYS OF VALUES RETURNED ; [ 03/03/2009  9:28 AM ]

 +1       ;;2.0;IHS PCC SUITE;;MAR 3, 2009

 +2       ;-----

 +3       ;FIRST LINE PARAMETER PASS OKAY'ED BY SAC COMMITTEE TO ALLOW OTHER PACKAGES TO CHANGE THEIR CALLS

 +4       ;

EN        ; - ENTRY POINT - Generation of taxonomy by end user

 +1       ; X=dfn attribute in QMAN DICTIONARY OF TERMS file

 +2       ; AMQQGTX=array for values to passed back in 

 +3       ; Y=dfn of the Taxonomy

 +4        IF $GET(Y)

               IF $GET(AMQQGTX)]""

                   DO TAX

                   QUIT 

 +5        IF '$DATA(X)!'$DATA(AMQQGTX)

               WRITE !,"Required variables not passed"

               QUIT 

 +6        IF '$PIECE($GET(^AMQQ(5,X,0)),U,14)

               WRITE !,"Unacceptable QMAN term.  Taxonomy creation not allowed!"

               QUIT 

 +7        SET AMQQATNM=$PIECE(^AMQQ(5,X,0),U)

 +8        DO EN1^AMQQTX

EN1        IF $DATA(^UTILITY("AMQQ TAX",$JOB))

               SET %=0

               FOR 

                   SET %=$ORDER(^UTILITY("AMQQ TAX",$JOB,1,%))

                   IF %=""

                       QUIT 

                   SET @(AMQQGTX_""""_%_""")")=""

 +1        KILL AMQQCCLS,AMQQMULT,AMQQQUIT,AMQQCNAM,AMQQQ,AMQQURGN,DR,DIE,AMQQDF,^UTILITY("AMQQ TAX",$JOB),AMQQGTX,AMQQATNM

 +2        QUIT 

 +3       ;

PEP(X,AMQQGTX,Y) ; - PUBLISHED ENTRY POINT - Generation of taxonomy by end user

 +1        DO EN

 +2        QUIT 

TAX       ;EVALUATE TAXONOMY

 +1        KILL ^UTILITY("AMQQ TAX",$JOB)

 +2        IF '$DATA(^ATXAX(+Y,0))

               QUIT 

           SET %=^(0)

 +3        SET AMQQLINK=$PIECE(%,U,12)

 +4        SET AMQQTLOK=$PIECE(%,U,15)

 +5        IF 'AMQQLINK!'AMQQTLOK

               QUIT 

 +6        NEW J,K,L

 +7        SET J=0

 +8        FOR 

               SET J=$ORDER(^AMQQ(5,J))

               IF 'J!(J>999)

                   QUIT 

               SET K=^(J,0)

               SET L=$PIECE(K,U,14)

               SET K=$PIECE(K,U,5)

               IF K=AMQQLINK&L

                   SET M(K,L)=""

 +9        SET AMQQTAXT=$ORDER(M(AMQQLINK,0))

 +10       IF 'AMQQTAXT

               QUIT 

 +11       SET AMQQHILO="^UTILITY(""AMQQ"",$J,""HILO"")"

 +12       IF '$GET(AMQQURGN)

               SET AMQQURGN=1

 +13       SET AMQQTLOK=$GET(^DIC(+AMQQTLOK,0,"GL"))

 +14       IF AMQQTLOK[","

               SET AMQQTGBL=$PIECE(AMQQTLOK,",")_")"

 +15      IF '$TEST

               SET AMQQTGBL=$PIECE(AMQQTLOK,"(")

 +16       IF $GET(AMQQTGBL)=""

               QUIT 

 +17       NEW AMQQXX

 +18       SET AMQQXX=""

 +19       DO REST^AMQQTX0

 +20       DO EN1

 +21       QUIT