AMQQCMPC.m

AMQQCMPC ; IHS/CMI/THL - AUTO SEARCH TEMPLATE GENERATION FROM EN3^AMQQ ;

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

 ;-----

RUN I AMQQEN31=+AMQQEN31 D DFN G EXIT

 D NAME

EXIT K Y,X,AMQQEN31,I,%

 Q

 ;

DOC F AMQQILIN=0:0 S AMQQILIN=$O(^UTILITY("AMQQ",$J,"LIST",AMQQILIN)) Q:'AMQQILIN  S AMQQLX=^(AMQQILIN) D PARSE

 S ^UTILITY("AMQQ",$J,"DOC",.0001)=" ---"

 S DIE="^DIBT("

 S DA=AMQQEN31

 I '$D(^DIBT(AMQQEN31,"%D",0)) S ^(0)="^^0^0^"

 F AMQQILIN=0:0 S AMQQILIN=$O(^UTILITY("AMQQ",$J,"DOC",AMQQILIN)) Q:'AMQQILIN  S DR="10///+"_^(AMQQILIN) D ^DIE

 K DIE,DA,DR,DIC

 Q

 ;

PARSE N Y,Z,%,I

 S Z=""

 F I=1:1 S Y=$P(AMQQLX,",",I) Q:$P(AMQQLX,",",I,99)=""  D TRANS I Y'="" S Z=Z_Y

 S ^UTILITY("AMQQ",$J,"DOC",AMQQILIN)=Z

 Q

 ;

TRANS I $E(Y)="@" S Y="" Q

 I Y?1"W ?"1.N S %=+$P(Y,"?",2),Y="",$P(Y," ",%-1)="" Q

 S Y=$TR(Y,"""","")

 I Y["   [SER" S Y=$P(Y,"   [SER")

 Q

 ;

DFN S AMQQDIBT=AMQQEN31+.1

 D MSG

 X AMQV(0)

 S AMQQEN3=AMQQTOT

 D DOC

 K ^DIBT(AMQQEN31,1)

 F %=0:0 S %=$O(^DIBT(AMQQDIBT,1,%)) Q:'%  S ^DIBT(AMQQEN31,1,%)=""

 K ^DIBT(AMQQDIBT,1)

 S ^DIBT(AMQQEN31,1,0)=AMQQEN3

 Q

 ;

NAME F  Q:'$D(^DIBT("B",AMQQEN31))  S DA=$O(^(AMQQEN31,"")),DIK="^DIBT(" D ^DIK K DIC,DIK,DA

 S X=AMQQEN31

 S DIC="^DIBT("

 S DIC(0)="L"

 S DIADD=1

 S DIC("DR")="2////"_DT_";3////"_DUZ(0)_";4////9000001;5////"_DUZ

 D FILE^DICN

 K DIC,DIADD

 I Y=-1 S AMQQQUIT="" Q

 S (AMQQEN31,AMQQDIBT)=+Y

 D MSG

 X AMQV(0)

 S ^DIBT(AMQQEN31,1,0)=AMQQTOT

 S AMQQEN3=AMQQEN31

 D DOC

 Q

 ;

MSG W !!,"I am about to conduct a search and save the results.",!

 W "Please be patient...",!!!

 H 3

 Q

 ;

AMQQCMPC  ; IHS/CMI/THL - AUTO SEARCH TEMPLATE GENERATION FROM EN3^AMQQ ;

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

 +2       ;-----

RUN        IF AMQQEN31=+AMQQEN31

               DO DFN

               GOTO EXIT

 +1        DO NAME

EXIT       KILL Y,X,AMQQEN31,I,%

 +1        QUIT 

 +2       ;

DOC        FOR AMQQILIN=0:0

               SET AMQQILIN=$ORDER(^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN))

               IF 'AMQQILIN

                   QUIT 

               SET AMQQLX=^(AMQQILIN)

               DO PARSE

 +1        SET ^UTILITY("AMQQ",$JOB,"DOC",.0001)=" ---"

 +2        SET DIE="^DIBT("

 +3        SET DA=AMQQEN31

 +4        IF '$DATA(^DIBT(AMQQEN31,"%D",0))

               SET ^(0)="^^0^0^"

 +5        FOR AMQQILIN=0:0

               SET AMQQILIN=$ORDER(^UTILITY("AMQQ",$JOB,"DOC",AMQQILIN))

               IF 'AMQQILIN

                   QUIT 

               SET DR="10///+"_^(AMQQILIN)

               DO ^DIE

 +6        KILL DIE,DA,DR,DIC

 +7        QUIT 

 +8       ;

PARSE      NEW Y,Z,%,I

 +1        SET Z=""

 +2        FOR I=1:1

               SET Y=$PIECE(AMQQLX,",",I)

               IF $PIECE(AMQQLX,",",I,99)=""

                   QUIT 

               DO TRANS

               IF Y'=""

                   SET Z=Z_Y

 +3        SET ^UTILITY("AMQQ",$JOB,"DOC",AMQQILIN)=Z

 +4        QUIT 

 +5       ;

TRANS      IF $EXTRACT(Y)="@"

               SET Y=""

               QUIT 

 +1        IF Y?1"W ?"1.N

               SET %=+$PIECE(Y,"?",2)

               SET Y=""

               SET $PIECE(Y," ",%-1)=""

               QUIT 

 +2        SET Y=$TRANSLATE(Y,"""","")

 +3        IF Y["   [SER"

               SET Y=$PIECE(Y,"   [SER")

 +4        QUIT 

 +5       ;

DFN        SET AMQQDIBT=AMQQEN31+.1

 +1        DO MSG

 +2        XECUTE AMQV(0)

 +3        SET AMQQEN3=AMQQTOT

 +4        DO DOC

 +5        KILL ^DIBT(AMQQEN31,1)

 +6        FOR %=0:0

               SET %=$ORDER(^DIBT(AMQQDIBT,1,%))

               IF '%

                   QUIT 

               SET ^DIBT(AMQQEN31,1,%)=""

 +7        KILL ^DIBT(AMQQDIBT,1)

 +8        SET ^DIBT(AMQQEN31,1,0)=AMQQEN3

 +9        QUIT 

 +10      ;

NAME       FOR 

               IF '$DATA(^DIBT("B",AMQQEN31))

                   QUIT 

               SET DA=$ORDER(^(AMQQEN31,""))

               SET DIK="^DIBT("

               DO ^DIK

               KILL DIC,DIK,DA

 +1        SET X=AMQQEN31

 +2        SET DIC="^DIBT("

 +3        SET DIC(0)="L"

 +4        SET DIADD=1

 +5        SET DIC("DR")="2////"_DT_";3////"_DUZ(0)_";4////9000001;5////"_DUZ

 +6        DO FILE^DICN

 +7        KILL DIC,DIADD

 +8        IF Y=-1

               SET AMQQQUIT=""

               QUIT 

 +9        SET (AMQQEN31,AMQQDIBT)=+Y

 +10       DO MSG

 +11       XECUTE AMQV(0)

 +12       SET ^DIBT(AMQQEN31,1,0)=AMQQTOT

 +13       SET AMQQEN3=AMQQEN31

 +14       DO DOC

 +15       QUIT 

 +16      ;

MSG        WRITE !!,"I am about to conduct a search and save the results.",!

 +1        WRITE "Please be patient...",!!!

 +2        HANG 3

 +3        QUIT 

 +4       ;