AMQQCMPM.m

AMQQCMPM ; IHS/CMI/THL - RESOLVES DISPLAY OF MULTIPLE MULTIPLES ; 12 Mar 2015  1:09 PM

 ;;2.0;IHS PCC SUITE;**4,5,11**;MAY 14, 2009;Build 58

MM N N,X,Y,Z,%,DIC,A,B,I

 K AMQQDVQU

 D ALL

 I $D(AMQQQUIT) G EXIT

 F I=1:1:($L(AMQQMULX,U)-2) S N=$P(AMQQMULX,U,I) D MM1

EXIT K AMQQMULX

 Q

 ;

MM1 ;

 I $D(^UTILITY("AMQQ",$J,"Q",N))=1 D  Q

 .S %=$P(^UTILITY("AMQQ",$J,"Q",N),U,9)

 .S:+^UTILITY("AMQQ",$J,"Q",N)'=758 $P(^UTILITY("AMQQ",$J,"Q",N),U,14)=1

 .Q:%["NULL"!(%["INVERSE")

 .S $P(%,";",4)="EXISTS",$P(^UTILITY("AMQQ",$J,"Q",N),U,9)=%

 F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"Q",N,%)) Q:'%  S Z=%

 S ^UTILITY("AMQQ",$J,"Q",N,Z+1)=Y_"^U^EXIST^AMQQF^3^^0^0",$P(^UTILITY("AMQQ",$J,"Q",N),U,14)=1

 Q

 ;

ALL S %=$L(AMQQMULX,U)

 S %=$P(AMQQMULX,U,%-1)

 S AMQQMULN=%

 S AMQQOBJ=$P(^UTILITY("AMQQ",$J,"Q",%),U,2)

 S AMQQOBJS=AMQQOBJ_$S($E(AMQQOBJ,$L(AMQQOBJ))?1P!($E(AMQQOBJ,$L(AMQQOBJ))="S"):"",1:"S")

 S AMQQMULL=AMQQMULN

 I AMQQCCLS="V" G ALLEXIT

 F %="NULL","INVERSE" I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,9)[% D SPEC G ALLEXIT

 I $D(AMQQXX) S X=$S($D(AMQQXX("FORMAT")):AMQQXX("FORMAT"),1:2) G X1

 S %=$G(AMQV("OPTION"))

 S %=$S(%="MAIL":2,%="HSUM":2,%="WORK":1,%="WORK":1,%="TIME":1,%="MONTH":1,1:0)

 I % S X=% G @("X"_X)

 I $D(^UTILITY("AMQQ",$J,"SQXQ",AMQQMULN)) S Z=$O(^(AMQQMULN,"")) I Z F %="NULL","ALL","EXISTS","ANY","INVERSE" I $D(^UTILITY("AMQQ",$J,"SQ",Z,%)) S X=2 S:Z'="ALL"&(Z'="ANY") $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,14)=1 G ALLEXIT

 I $D(^UTILITY("AMQQ",$J,"Q",AMQQMULN,1)),$P(^(1),U,2)="NULL" G ALLEXIT

 I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,9)["ANY" G ALLEXIT

 I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,3)="I" S %=$P(^(AMQQMULN),U,9) I $P(%,";",5)=2 G ALLEXIT

 S %=$P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,13)

 I %,%'=4 G ALLEXIT

 S X=+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULN))

 I X,$D(^AMQQ(1,X,9)),$P(^(9),U)'="" S AMQQN=^(9) D MULT G ALLEXIT

 I $D(AMQQONE) S X=1 G X1

 I AMQV("OPTION")="COHORT" S X=2 G X2

 S A="@AMQQRV,""PATIENTS"",@AMQQNV"

 S B="@AMQQRV,"""_AMQQOBJS_""",@AMQQNV"

 S %="list"

 I $G(AMQV("OPTION"))="COUNT" S %="count"

 W !!,"You have 2 options for ",%,"ing ",AMQQOBJS," =>",!

 W !?5,"1) For ea. patient, ",%," all ",@B," which match your",!?8,"criteria"

 W !?5,"2) ",$S(AMQV("OPTION")="COUNT":"Count",1:"List")," all ",@A," with ",AMQQOBJS," meeting your criteria,",!?8,"but do not ",%," the individual values of ea. ",AMQQOBJ,!

ALLQ W !,"Your choice (1 or 2): 1// "

 R X:DTIME E  S X=U

 I $E(X)=U S AMQQQUIT="" G ALLEXIT

 I X="" S X=1 W " (1)"

 I X?1."?" D HELP G ALL

X1 I X=1 D:$D(^UTILITY("AMQQ",$J,"Q",AMQQMULN)) X11 G ALLEXIT

X2 I X=2 S AMQQMULX=AMQQMULX_AMQQMULN_U G ALLEXIT

 W "  ??",*7

 G ALLQ

ALLEXIT K AMQQMULN,AMQQOBJ,AMQQOBJS,A,B,AMQQN,AMQQNO3

 Q

 ;

CD W !!,"You have 2 options for counting ",AMQQN(1)," =>",!

 W !?5,"1) Count all specified ",AMQQN(2)," for all patients"

 S AMQQI=0

 F  S AMQQI=$O(^UTILITY("AMQQ",$J,"LIST",AMQQI)) Q:'AMQQI!($D(AMQQSTP))  I ^(AMQQI)[$E(AMQQN(1),1,($L(AMQQN(1))-2)) S:$D(AMQQHIT) AMQQSTP="" S AMQQHIT=""

 W !?5,"2) Count PATIENTS with at least one of the ",$S('$D(AMQQSTP):AMQQN(1),1:AMQQN(1)_" in each query"),!,?7," you specified",!

 K AMQQSTP,AMQQHIT

CDQ W !,"Your choice (1-2): 1// "

 R X:DTIME E  S X=U

 I X=2 S X=3 Q

 I X="" Q

 I X=1 Q

 I X?1."?" D HELP G CD

 I $E(X)=U Q

 W "  ??",*7

 G CDQ

 ;

HELP N %A,%B

 S XQH=$O(^DIC(9.2,"B","AMQQLIST",""))

 D EN1^XQH

 Q

 ;

MULT F I=1:1:3 S AMQQN(I)=$P(AMQQN,U,I)

 I AMQV("OPTION")="COHORT" S X=3 G X3

 S %=$P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,15)

 S %=$P(%,";",4)

 I %,$D(^UTILITY("AMQQ TAX",$J,%,"--"))!$D(^UTILITY("AMQQ TAX",$J,%,"-")) Q

 I AMQV("OPTION")="COUNT" D CD G DXQA

 I $D(AMQQONE) S X=2 G DXQA

 W !!,"You have ",$S('$D(AMQQNO3):3,1:2)," options for listing ",AMQQN(1)," =>",!

 W !?5,"1) List every ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," meeting search criteria."

 W !?5,"2) List every ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," and ",$S(AMQQN(3)="PROVIDER NARRATIVES":"PROVIDER NARRATIVE",1:AMQQN(3))," meeting search criteria." I $D(AMQQNO3) W !

 I '$D(AMQQNO3) W !?5,"3) List all PATIENTS with ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," you specified, but DO NOT list",!?8,"individual ",$S(AMQQN(2)="ICD9 CODES":"ICD CODES",1:AMQQN(2))," or ",AMQQN(3)," (FASTEST OPTION!!)",!

 W ?8,"(Displays UNDUPLICATED list of PATIENTS)",!

DXQ W !,"Your choice (1-",(3-$D(AMQQNO3)),"): 1// "

 R X:DTIME E  S X=U

DXQA I $E(X)=U S AMQQQUIT="" G DXEXIT

 I X="" S X=1 W " (1)"

 I X?1."?" D HELP G MULT

DXQA1 I X=2 S %=+^UTILITY("AMQQ",$J,"Q",AMQQMULN) D  Q

 .I %>999 D EXP Q

 .S:$D(^AMQQ(1,%+.1)) $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,1)=%+.1 S $P(^(AMQQMULN),U,18)=1,$P(^(AMQQMULN),U,14)=3

 .Q

X11 ;IHS/CMI/LAB - addded question about qualifiers

 ;I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1 Q  ;,$P(^(AMQQMULN),U,14)=2 Q

 K AMQQDVQU

 I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1

 I $P(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULL)),0),U,3)=9000010.01 D

 .NEW X

 .K DIR,AMQQDVQU

 .S DIR(0)="Y",DIR("A")="Do you want to display associated measurement qualifiers with each "_AMQQOBJS,DIR("B")="N",DIR("?")="If you want to display the qualifiers (e.g. Oral, Left Arm, etc) enter Y for Yes." KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) K AMQQDVQU Q

 .I 'Y K AMQQDVQU Q

 .S AMQQDVQU=1

 .Q

 I X=1 Q

X3 I '$D(AMQQNO3),X=3 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=2,AMQQMULX=AMQQMULX_AMQQMULN_U Q

 W " ??",*7

 G DXQ

DXEXIT K X

 Q

 ;

SPEC I $G(AMQV("OPTION"))'="COHORT",%="ALL"!(%="ANY"),$D(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULN)),9)) S:%="ANY" AMQQNO3="" S AMQQN=^(9) D MULT Q

 S X=2-((%="ALL")!(%="ANY"))

 D DXQA1

 Q

 ;

EXP ; EXPANDED LAB OUTPUT

 N X,Y,Z

 S $P(^AMQQ(1,%,4,1,0),U,5,6)="30^30",^(1)="D EXP^AMQQDO"

 Q

 ;

AMQQCMPM  ; IHS/CMI/THL - RESOLVES DISPLAY OF MULTIPLE MULTIPLES ; 12 Mar 2015  1:09 PM

 +1       ;;2.0;IHS PCC SUITE;**4,5,11**;MAY 14, 2009;Build 58

MM         NEW N,X,Y,Z,%,DIC,A,B,I

 +1        KILL AMQQDVQU

 +2        DO ALL

 +3        IF $DATA(AMQQQUIT)

               GOTO EXIT

 +4        FOR I=1:1:($LENGTH(AMQQMULX,U)-2)

               SET N=$PIECE(AMQQMULX,U,I)

               DO MM1

EXIT       KILL AMQQMULX

 +1        QUIT 

 +2       ;

MM1       ;

 +1        IF $DATA(^UTILITY("AMQQ",$JOB,"Q",N))=1

               Begin DoDot:1

 +2                SET %=$PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,9)

 +3                IF +^UTILITY("AMQQ",$JOB,"Q",N)'=758

                       SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,14)=1

 +4                IF %["NULL"!(%["INVERSE")

                       QUIT 

 +5                SET $PIECE(%,";",4)="EXISTS"

                   SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,9)=%

               End DoDot:1

               QUIT 

 +6        FOR %=0:0

               SET %=$ORDER(^UTILITY("AMQQ",$JOB,"Q",N,%))

               IF '%

                   QUIT 

               SET Z=%

 +7        SET ^UTILITY("AMQQ",$JOB,"Q",N,Z+1)=Y_"^U^EXIST^AMQQF^3^^0^0"

           SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,14)=1

 +8        QUIT 

 +9       ;

ALL        SET %=$LENGTH(AMQQMULX,U)

 +1        SET %=$PIECE(AMQQMULX,U,%-1)

 +2        SET AMQQMULN=%

 +3        SET AMQQOBJ=$PIECE(^UTILITY("AMQQ",$JOB,"Q",%),U,2)

 +4        SET AMQQOBJS=AMQQOBJ_$SELECT($EXTRACT(AMQQOBJ,$LENGTH(AMQQOBJ))?1P!($EXTRACT(AMQQOBJ,$LENGTH(AMQQOBJ))="S"):"",1:"S")

 +5        SET AMQQMULL=AMQQMULN

 +6        IF AMQQCCLS="V"

               GOTO ALLEXIT

 +7        FOR %="NULL","INVERSE"

               IF $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,9)[%

                   DO SPEC

                   GOTO ALLEXIT

 +8        IF $DATA(AMQQXX)

               SET X=$SELECT($DATA(AMQQXX("FORMAT")):AMQQXX("FORMAT"),1:2)

               GOTO X1

 +9        SET %=$GET(AMQV("OPTION"))

 +10       SET %=$SELECT(%="MAIL":2,%="HSUM":2,%="WORK":1,%="WORK":1,%="TIME":1,%="MONTH":1,1:0)

 +11       IF %

               SET X=%

               GOTO @("X"_X)

 +12       IF $DATA(^UTILITY("AMQQ",$JOB,"SQXQ",AMQQMULN))

               SET Z=$ORDER(^(AMQQMULN,""))

               IF Z

                   FOR %="NULL","ALL","EXISTS","ANY","INVERSE"

                       IF $DATA(^UTILITY("AMQQ",$JOB,"SQ",Z,%))

                           SET X=2

                           IF Z'="ALL"&(Z'="ANY")

                               SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,14)=1

                           GOTO ALLEXIT

 +13       IF $DATA(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN,1))

               IF $PIECE(^(1),U,2)="NULL"

                   GOTO ALLEXIT

 +14       IF $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,9)["ANY"

               GOTO ALLEXIT

 +15       IF $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,3)="I"

               SET %=$PIECE(^(AMQQMULN),U,9)

               IF $PIECE(%,";",5)=2

                   GOTO ALLEXIT

 +16       SET %=$PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,13)

 +17       IF %

               IF %'=4

                   GOTO ALLEXIT

 +18       SET X=+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN))

 +19       IF X

               IF $DATA(^AMQQ(1,X,9))

                   IF $PIECE(^(9),U)'=""

                       SET AMQQN=^(9)

                       DO MULT

                       GOTO ALLEXIT

 +20       IF $DATA(AMQQONE)

               SET X=1

               GOTO X1

 +21       IF AMQV("OPTION")="COHORT"

               SET X=2

               GOTO X2

 +22       SET A="@AMQQRV,""PATIENTS"",@AMQQNV"

 +23       SET B="@AMQQRV,"""_AMQQOBJS_""",@AMQQNV"

 +24       SET %="list"

 +25       IF $GET(AMQV("OPTION"))="COUNT"

               SET %="count"

 +26       WRITE !!,"You have 2 options for ",%,"ing ",AMQQOBJS," =>",!

 +27       WRITE !?5,"1) For ea. patient, ",%," all ",@B," which match your",!?8,"criteria"

 +28       WRITE !?5,"2) ",$SELECT(AMQV("OPTION")="COUNT":"Count",1:"List")," all ",@A," with ",AMQQOBJS," meeting your criteria,",!?8,"but do not ",%," the individual values of ea. ",AMQQOBJ,!

ALLQ       WRITE !,"Your choice (1 or 2): 1// "

 +1        READ X:DTIME

          IF '$TEST

               SET X=U

 +2        IF $EXTRACT(X)=U

               SET AMQQQUIT=""

               GOTO ALLEXIT

 +3        IF X=""

               SET X=1

               WRITE " (1)"

 +4        IF X?1."?"

               DO HELP

               GOTO ALL

X1         IF X=1

               IF $DATA(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN))

                   DO X11

               GOTO ALLEXIT

X2         IF X=2

               SET AMQQMULX=AMQQMULX_AMQQMULN_U

               GOTO ALLEXIT

 +1        WRITE "  ??",*7

 +2        GOTO ALLQ

ALLEXIT    KILL AMQQMULN,AMQQOBJ,AMQQOBJS,A,B,AMQQN,AMQQNO3

 +1        QUIT 

 +2       ;

CD         WRITE !!,"You have 2 options for counting ",AMQQN(1)," =>",!

 +1        WRITE !?5,"1) Count all specified ",AMQQN(2)," for all patients"

 +2        SET AMQQI=0

 +3        FOR 

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

               IF 'AMQQI!($DATA(AMQQSTP))

                   QUIT 

               IF ^(AMQQI)[$EXTRACT(AMQQN(1),1,($LENGTH(AMQQN(1))-2))

                   IF $DATA(AMQQHIT)

                       SET AMQQSTP=""

                   SET AMQQHIT=""

 +4        WRITE !?5,"2) Count PATIENTS with at least one of the ",$SELECT('$DATA(AMQQSTP):AMQQN(1),1:AMQQN(1)_" in each query"),!,?7," you specified",!

 +5        KILL AMQQSTP,AMQQHIT

CDQ        WRITE !,"Your choice (1-2): 1// "

 +1        READ X:DTIME

          IF '$TEST

               SET X=U

 +2        IF X=2

               SET X=3

               QUIT 

 +3        IF X=""

               QUIT 

 +4        IF X=1

               QUIT 

 +5        IF X?1."?"

               DO HELP

               GOTO CD

 +6        IF $EXTRACT(X)=U

               QUIT 

 +7        WRITE "  ??",*7

 +8        GOTO CDQ

 +9       ;

HELP       NEW %A,%B

 +1        SET XQH=$ORDER(^DIC(9.2,"B","AMQQLIST",""))

 +2        DO EN1^XQH

 +3        QUIT 

 +4       ;

MULT       FOR I=1:1:3

               SET AMQQN(I)=$PIECE(AMQQN,U,I)

 +1        IF AMQV("OPTION")="COHORT"

               SET X=3

               GOTO X3

 +2        SET %=$PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,15)

 +3        SET %=$PIECE(%,";",4)

 +4        IF %

               IF $DATA(^UTILITY("AMQQ TAX",$JOB,%,"--"))!$DATA(^UTILITY("AMQQ TAX",$JOB,%,"-"))

                   QUIT 

 +5        IF AMQV("OPTION")="COUNT"

               DO CD

               GOTO DXQA

 +6        IF $DATA(AMQQONE)

               SET X=2

               GOTO DXQA

 +7        WRITE !!,"You have ",$SELECT('$DATA(AMQQNO3):3,1:2)," options for listing ",AMQQN(1)," =>",!

 +8        WRITE !?5,"1) List every ",$SELECT(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," meeting search criteria."

 +9        WRITE !?5,"2) List every ",$SELECT(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," and ",$SELECT(AMQQN(3)="PROVIDER NARRATIVES":"PROVIDER NARRATIVE",1:AMQQN(3))," meeting search criteria."

           IF $DATA(AMQQNO3)

               WRITE !

 +10       IF '$DATA(AMQQNO3)

               WRITE !?5,"3) List all PATIENTS with ",$SELECT(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," you specified, but DO NOT list",!?8,"individual ",$SELECT(AMQQN(2)="ICD9 CODES":"ICD CODES",1:AMQQN(2))," or ",AMQQN(3)," (FASTEST OPTION!!)",!

 +11       WRITE ?8,"(Displays UNDUPLICATED list of PATIENTS)",!

DXQ        WRITE !,"Your choice (1-",(3-$DATA(AMQQNO3)),"): 1// "

 +1        READ X:DTIME

          IF '$TEST

               SET X=U

DXQA       IF $EXTRACT(X)=U

               SET AMQQQUIT=""

               GOTO DXEXIT

 +1        IF X=""

               SET X=1

               WRITE " (1)"

 +2        IF X?1."?"

               DO HELP

               GOTO MULT

DXQA1      IF X=2

               SET %=+^UTILITY("AMQQ",$JOB,"Q",AMQQMULN)

               Begin DoDot:1

 +1                IF %>999

                       DO EXP

                       QUIT 

 +2                IF $DATA(^AMQQ(1,%+.1))

                       SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,1)=%+.1

                   SET $PIECE(^(AMQQMULN),U,18)=1

                   SET $PIECE(^(AMQQMULN),U,14)=3

 +3                QUIT 

               End DoDot:1

               QUIT 

X11       ;IHS/CMI/LAB - addded question about qualifiers

 +1       ;I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1 Q  ;,$P(^(AMQQMULN),U,14)=2 Q

 +2        KILL AMQQDVQU

 +3        IF X=1

               SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,18)=1

 +4        IF $PIECE(^AMQQ(1,+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULL)),0),U,3)=9000010.01

               Begin DoDot:1

 +5                NEW X

 +6                KILL DIR,AMQQDVQU

 +7                SET DIR(0)="Y"

                   SET DIR("A")="Do you want to display associated measurement qualifiers with each "_AMQQOBJS

                   SET DIR("B")="N"

                   SET DIR("?")="If you want to display the qualifiers (e.g. Oral, Left Arm, etc) enter Y for Yes."

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +8                IF $DATA(DIRUT)

                       KILL AMQQDVQU

                       QUIT 

 +9                IF 'Y

                       KILL AMQQDVQU

                       QUIT 

 +10               SET AMQQDVQU=1

 +11               QUIT 

               End DoDot:1

 +12       IF X=1

               QUIT 

X3         IF '$DATA(AMQQNO3)

               IF X=3

                   SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,18)=2

                   SET AMQQMULX=AMQQMULX_AMQQMULN_U

                   QUIT 

 +1        WRITE " ??",*7

 +2        GOTO DXQ

DXEXIT     KILL X

 +1        QUIT 

 +2       ;

SPEC       IF $GET(AMQV("OPTION"))'="COHORT"

               IF %="ALL"!(%="ANY")

                   IF $DATA(^AMQQ(1,+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN)),9))

                       IF %="ANY"

                           SET AMQQNO3=""

                       SET AMQQN=^(9)

                       DO MULT

                       QUIT 

 +1        SET X=2-((%="ALL")!(%="ANY"))

 +2        DO DXQA1

 +3        QUIT 

 +4       ;

EXP       ; EXPANDED LAB OUTPUT

 +1        NEW X,Y,Z

 +2        SET $PIECE(^AMQQ(1,%,4,1,0),U,5,6)="30^30"

           SET ^(1)="D EXP^AMQQDO"

 +3        QUIT 

 +4       ;