AMQQLXR.m

AMQQLXR ; IHS/CMI/THL - SETS AQ1 XREF ON BLOOD QUANTUM FLD IN PT FILE ;

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

REINDEX ;

 S U="^"

 I $P(^AUTTSITE(1,0),U,19)'="Y" D  Q

 .W *7,!,"""AQ"" indices for Q-MAN not currently set up."

 .W !,"Use Q-MAN site manager option to create these indices."

 K ^AUPNPAT("AQ1")

 F DA=0:0 S DA=$O(^AUPNPAT(DA)) Q:'DA  S X=$P($G(^(DA,11)),U,10) K AMQQQXR D QXR I $D(AMQQQXR) S ^AUPNPAT("AQ1",AMQQQXR,DA)=""

 K ^AUPNPAT("AQ2")

 F DA=0:0 S DA=$O(^AUPNPAT(DA)) Q:'DA  S X=$P($G(^(DA,11)),U,9) K AMQQQXR D QXR I $D(AMQQQXR) S ^AUPNPAT("AQ2",AMQQQXR,DA)=""

 Q

 ;

QXR ; ENTRY POINT

 I X="" Q

 N %

 S %=X

 N X

 I %["/" S %=(+%/$S($P(%,"/",2):$P(%,"/",2),1:1)) S:$E(%)="." %=0_%,AMQQQXR=$E(%,1,8)+1 S:'$D(AMQQQXR) AMQQQXR=%+1 Q

 S %=$S($E(%)="F":2,$E(%)="N":1,$E(%,1,3)="UNK":2.1,$E(%,1,3)="UNS":2.2,1:"")

 I %'="" S AMQQQXR=%

 Q

 ;

AMQQLXR   ; IHS/CMI/THL - SETS AQ1 XREF ON BLOOD QUANTUM FLD IN PT FILE ;

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

REINDEX   ;

 +1        SET U="^"

 +2        IF $PIECE(^AUTTSITE(1,0),U,19)'="Y"

               Begin DoDot:1

 +3                WRITE *7,!,"""AQ"" indices for Q-MAN not currently set up."

 +4                WRITE !,"Use Q-MAN site manager option to create these indices."

               End DoDot:1

               QUIT 

 +5        KILL ^AUPNPAT("AQ1")

 +6        FOR DA=0:0

               SET DA=$ORDER(^AUPNPAT(DA))

               IF 'DA

                   QUIT 

               SET X=$PIECE($GET(^(DA,11)),U,10)

               KILL AMQQQXR

               DO QXR

               IF $DATA(AMQQQXR)

                   SET ^AUPNPAT("AQ1",AMQQQXR,DA)=""

 +7        KILL ^AUPNPAT("AQ2")

 +8        FOR DA=0:0

               SET DA=$ORDER(^AUPNPAT(DA))

               IF 'DA

                   QUIT 

               SET X=$PIECE($GET(^(DA,11)),U,9)

               KILL AMQQQXR

               DO QXR

               IF $DATA(AMQQQXR)

                   SET ^AUPNPAT("AQ2",AMQQQXR,DA)=""

 +9        QUIT 

 +10      ;

QXR       ; ENTRY POINT

 +1        IF X=""

               QUIT 

 +2        NEW %

 +3        SET %=X

 +4        NEW X

 +5        IF %["/"

               SET %=(+%/$SELECT($PIECE(%,"/",2):$PIECE(%,"/",2),1:1))

               IF $EXTRACT(%)="."

                   SET %=0_%

                   SET AMQQQXR=$EXTRACT(%,1,8)+1

               IF '$DATA(AMQQQXR)

                   SET AMQQQXR=%+1

               QUIT 

 +6        SET %=$SELECT($EXTRACT(%)="F":2,$EXTRACT(%)="N":1,$EXTRACT(%,1,3)="UNK":2.1,$EXTRACT(%,1,3)="UNS":2.2,1:"")

 +7        IF %'=""

               SET AMQQQXR=%

 +8        QUIT 

 +9       ;