AMQQF3.m

AMQQF3 ; IHS/CMI/THL - PARENT FUNCTIONS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ; &&& NEW ROUTINE

 ;-----

PARENT ; ENTRY POINT FROM AMQQCMPL

 N X,Y,Z,%,A,B,C,AMQQPT,AMQQPS,AMQQPV1,AMQQPV2,AMQQPV3,AMQQPV4,AMQQPV,AMQQPI,AMQQPJ

 F AMQQPI=1:1 S %=$P(AMQQCOMP,"~",AMQQPI) Q:%=""  S AMQQPT=$P(%,":",2),AMQQPS=$P(%,":",3),X=$P(%,":",4),AMQQPV1=$P(X,";"),AMQQPV2=$P(X,";",2),AMQQPV3=$P(X,";",3),AMQQPV4=$P(X,";",4) D

 .F AMQQPJ=0:0 S AMQQPJ=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQPJ)) Q:'AMQQPJ  D TEST

EXIT K X

 Q

 ; 

TEST S %=$P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQPJ),U,4)

 S %=(U_AMQQGR_"("_%_",0)")

 S %=$P(@%,U,7)

 I '% K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQPJ) Q

 S %=(U_AMQQGR_"("_%_",0)")

 S AMQQPV=$P($G(@%),U,4)

 D @("PAR"_AMQQPT)

 N T

 S T=$T

 I '$D(AMQQNOT)=T K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQPJ)

 E  I AMQQPI=1 S %=$P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,AMQQPJ),U),%=%_" ("_$E(AMQQPV,1,6)_")",$P(^(AMQQPJ),U,1)=%

 Q

 ;

PARS ; SET OF CODES

PARP ; POINTER

 I AMQQPS="=",AMQQPV'=AMQQPV1 Q

 I AMQQPS="'=",AMQQPV=AMQQPV1 Q

 Q

 ;

PARL ; LOOKUP SET

PARG ; GROUP

 I $D(^UTILITY("AMQQ TAX",$J,AMQQPV4,AMQQPV))+$D(^("*"))=$D(^("--"))

 Q

 ;

AMQQF3    ; IHS/CMI/THL - PARENT FUNCTIONS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ; &&& NEW ROUTINE

 +3       ;-----

PARENT    ; ENTRY POINT FROM AMQQCMPL

 +1        NEW X,Y,Z,%,A,B,C,AMQQPT,AMQQPS,AMQQPV1,AMQQPV2,AMQQPV3,AMQQPV4,AMQQPV,AMQQPI,AMQQPJ

 +2        FOR AMQQPI=1:1

               SET %=$PIECE(AMQQCOMP,"~",AMQQPI)

               IF %=""

                   QUIT 

               SET AMQQPT=$PIECE(%,":",2)

               SET AMQQPS=$PIECE(%,":",3)

               SET X=$PIECE(%,":",4)

               SET AMQQPV1=$PIECE(X,";")

               SET AMQQPV2=$PIECE(X,";",2)

               SET AMQQPV3=$PIECE(X,";",3)

               SET AMQQPV4=$PIECE(X,";",4)

               Begin DoDot:1

 +3                FOR AMQQPJ=0:0

                       SET AMQQPJ=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQPJ))

                       IF 'AMQQPJ

                           QUIT 

                       DO TEST

               End DoDot:1

EXIT       KILL X

 +1        QUIT 

 +2       ; 

TEST       SET %=$PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQPJ),U,4)

 +1        SET %=(U_AMQQGR_"("_%_",0)")

 +2        SET %=$PIECE(@%,U,7)

 +3        IF '%

               KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQPJ)

               QUIT 

 +4        SET %=(U_AMQQGR_"("_%_",0)")

 +5        SET AMQQPV=$PIECE($GET(@%),U,4)

 +6        DO @("PAR"_AMQQPT)

 +7        NEW T

 +8        SET T=$TEST

 +9        IF '$DATA(AMQQNOT)=T

               KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQPJ)

 +10      IF '$TEST

               IF AMQQPI=1

                   SET %=$PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,AMQQPJ),U)

                   SET %=%_" ("_$EXTRACT(AMQQPV,1,6)_")"

                   SET $PIECE(^(AMQQPJ),U,1)=%

 +11       QUIT 

 +12      ;

PARS      ; SET OF CODES

PARP      ; POINTER

 +1        IF AMQQPS="="

               IF AMQQPV'=AMQQPV1

                   QUIT 

 +2        IF AMQQPS="'="

               IF AMQQPV=AMQQPV1

                   QUIT 

 +3        QUIT 

 +4       ;

PARL      ; LOOKUP SET

PARG      ; GROUP

 +1        IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQPV4,AMQQPV))+$DATA(^("*"))=$DATA(^("--"))

 +2        QUIT 

 +3       ;