AMQQ200.m

AMQQ200 ; IHS/CMI/THL - SLC ISC/GIS - CONVERSION TO FILE #200 ;

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

 ;-----

NEW N X,Y,Z,%,DIRUT,DIROUT,DTOUT,DUOUT

 I $P(^AMQQ(8,DUZ(2),0),U,6) Q  ; CONVERSION WAS DONE PREVIOUSLY

 I '$O(^VA(200,0)) Q  ; FILE #200 NOT PRESENT

 I '$P($G(^AUTTSITE(1,0)),U,22) Q  ; PCC FILE CONVERSION NOT COMPLETE

 W !!!,*7,"Hmmm, it appears that you have not upgraded Q-Man to recognize file #200, the"

 W !,"***  NEW PERSON FILE  ***"

 W !!

 S DIR(0)="Y"

 S DIR("A")="Let's do the upgrade now, OK"

 S DIR("B")="YES"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I Y D DIE,META

EXIT ;

 Q

 ;

DIE S DIE="^AMQQ(8,"

 S DA=DUZ(2)

 S DR=".06///1"

 D ^DIE

 K DIE,DR,DA,DIC

 ; SET FLAG IN Q-MAN SITE PARAM FILE TO INDICATE FILE #200 CONVERSION

 Q

 ;

STUFF ; DEVELOPERS UTILITY TO STUFF ENTRIES INTO THE QMAN FILE 200 CONVERSION FILE

 N X,Y,Z,%,I S I=0

 S X="^AMQQ(0)" F  S X=$Q(@X) Q:X'?1"^AMQQ(".E  Q:+$P(X,"(",2)>5  D

 . S %=@X I %'["DIC(16,",%'["DIC(6,",%'["DIC(3," Q

 . S Z=$P(X,U,2),I=I+1

 . W !,X,!,%,!

 S $P(^AMQQ(8.1,0),U,3,4)=(I_U_I)

 Q

 ;

META ; METADICTIONARY CONVERSION

 F X=0:0 S X=$O(^AMQQ(8.1,X)) Q:'X  S Y=U_^(X,0),Z=^(1) S @Y=Z

 Q

 ;

RERUN ;EP;TO RERUN FILE 200 CONVERSION

 I $G(^DD(9000010.06,.01,0))'[200 D  Q

 .Q:$D(ZTSK)!$D(ZTQUEUED)

 .W !!,"File 200 conversion has not been done on this system."

 .H 3

 S $P(^AMQQ(8,DUZ(2),0),U,6)=""

 D NEW

 Q

AMQQ200   ; IHS/CMI/THL - SLC ISC/GIS - CONVERSION TO FILE #200 ;

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

 +2       ;-----

NEW        NEW X,Y,Z,%,DIRUT,DIROUT,DTOUT,DUOUT

 +1       ; CONVERSION WAS DONE PREVIOUSLY

           IF $PIECE(^AMQQ(8,DUZ(2),0),U,6)

               QUIT 

 +2       ; FILE #200 NOT PRESENT

           IF '$ORDER(^VA(200,0))

               QUIT 

 +3       ; PCC FILE CONVERSION NOT COMPLETE

           IF '$PIECE($GET(^AUTTSITE(1,0)),U,22)

               QUIT 

 +4        WRITE !!!,*7,"Hmmm, it appears that you have not upgraded Q-Man to recognize file #200, the"

 +5        WRITE !,"***  NEW PERSON FILE  ***"

 +6        WRITE !!

 +7        SET DIR(0)="Y"

 +8        SET DIR("A")="Let's do the upgrade now, OK"

 +9        SET DIR("B")="YES"

 +10       DO ^DIR

 +11       KILL DIR

 +12       IF $DATA(DUOUT)

               SET DIRUT=1

 +13       IF Y

               DO DIE

               DO META

EXIT      ;

 +1        QUIT 

 +2       ;

DIE        SET DIE="^AMQQ(8,"

 +1        SET DA=DUZ(2)

 +2        SET DR=".06///1"

 +3        DO ^DIE

 +4        KILL DIE,DR,DA,DIC

 +5       ; SET FLAG IN Q-MAN SITE PARAM FILE TO INDICATE FILE #200 CONVERSION

 +6        QUIT 

 +7       ;

STUFF     ; DEVELOPERS UTILITY TO STUFF ENTRIES INTO THE QMAN FILE 200 CONVERSION FILE

 +1        NEW X,Y,Z,%,I

           SET I=0

 +2        SET X="^AMQQ(0)"

           FOR 

               SET X=$QUERY(@X)

               IF X'?1"^AMQQ(".E

                   QUIT 

               IF +$PIECE(X,"(",2)>5

                   QUIT 

               Begin DoDot:1

 +3                SET %=@X

                   IF %'["DIC(16,"

                       IF %'["DIC(6,"

                           IF %'["DIC(3,"

                               QUIT 

 +4                SET Z=$PIECE(X,U,2)

                   SET I=I+1

 +5                WRITE !,X,!,%,!

               End DoDot:1

 +6        SET $PIECE(^AMQQ(8.1,0),U,3,4)=(I_U_I)

 +7        QUIT 

 +8       ;

META      ; METADICTIONARY CONVERSION

 +1        FOR X=0:0

               SET X=$ORDER(^AMQQ(8.1,X))

               IF 'X

                   QUIT 

               SET Y=U_^(X,0)

               SET Z=^(1)

               SET @Y=Z

 +2        QUIT 

 +3       ;

RERUN     ;EP;TO RERUN FILE 200 CONVERSION

 +1        IF $GET(^DD(9000010.06,.01,0))'[200

               Begin DoDot:1

 +2                IF $DATA(ZTSK)!$DATA(ZTQUEUED)

                       QUIT 

 +3                WRITE !!,"File 200 conversion has not been done on this system."

 +4                HANG 3

               End DoDot:1

               QUIT 

 +5        SET $PIECE(^AMQQ(8,DUZ(2),0),U,6)=""

 +6        DO NEW

 +7        QUIT