AMQQQ ; IHS/CMI/THL - SCRIPT INTERFACE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
;1:UNDEFINED OR ILLEGAL INPUT VARIABLE
;2:UNDEFINED OR ILLEGAL OUTPUT VARIABLE
;3:SUBJECT LOOKUP FAILED
;4:MORE THAN ONE SUBJECT
;5:UNABLE TO CREATE TAXONOMY
;6:ATTRIBUTE LOOKUP FAILED
;7:CONDITION LOOKUP FAILED
;8:FAILED TO FIND VALUE
;9:OR GROUP ERROR
;10:SUBQUERY ERROR
EN ; ENTRY POINT FROM SEARCH^AMQQ
K AMQQFAIL
RUN F AMQQQRUN=1:1:6 D @$P("KILL;VAL;ANAL;^AMQQQ0;^AMQQQ2;^AMQQCMPL",";",AMQQQRUN) Q:$D(AMQQQUIT) Q:$D(AMQQFAIL)
EXIT D KILL
Q
;
KILL K AMQQXXAA,AMQQXXAS,AMQQXXAT,AMQQXXCC,AMQQXXVV,AMQQNECO,AMQQRUN,AMQQQ,%,A,Z
K AMQQYYAT,AMQQXXGG,AMQQXXGO,AMQQXXGI,AMQQXXII,AMQQXXSS,AMQQXXXX
K AMQQATN,AMQQATNM,AMQQCTXS,AMQQFTYP,AMQQPRST,AMQQSBCT,AMQQVCL
K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
Q
;
VAL ; ENTRY POINT FROM AMQQE1
S X=AMQQXX
D TEST
I $D(AMQQFAIL) Q
D TEST1
I $D(AMQQFAIL) Q
S X=AMQQYY
I X[U,$P(X,U)=+X S AMQV("OPTION")="SAVE" G VAL1
D TEST
I $D(AMQQFAIL) S AMQQFAIL=2 Q
VAL1 S AMQQXXGO=AMQQYY_"AMQQXXGN)"
S AMQQNECO=""
I '$D(AMQV("OPTION")) S AMQV("OPTION")="LIST"
Q
;
TEST S %=$E(X,$L(X))
I %'=",",%'="(" S AMQQFAIL=1 Q
S %=$E(X,1,$L(X)-1)
S Y=$E(X,$L(X))
S Z=X
I Y="," S %=%_")"
S X="I "_%_"=1"
D ^DIM
I '$D(X) S AMQQFAIL=1
Q
;
TEST1 S Z=AMQQXX
S AMQQXXGG=Z_"AMQQXXGN)"
I $D(@(Z_"1,0)")) S AMQQXXGI=Z_"AMQQXXGN,0)" Q
I $D(@(Z_"1)")) S AMQQXXGI=Z_"AMQQXXGN)" Q
S AMQQFAIL=1
Q
;
ANAL F AMQQXXGN=0:0 S AMQQXXGN=$O(@AMQQXXGG) Q:'AMQQXXGN S AMQQXXXX=@AMQQXXGI D A1 I $D(AMQQFAIL)!($D(AMQQQUIT)) Q
I '$D(AMQQXX(0)) S AMQQFAIL=3
Q
;
A1 S %=AMQQXXXX
S %=$P(%,"**")
I %="" Q
I $E(%)="*",$E(%,2)'="*" S %=$E(%,2,999),X=$P(%,"="),AMQQXXSS=$P(%,"=",2,99)
E Q
S A=X
D STRIP
S X=A
I X="" S AMQQFAIL=1 Q
I X=$E("FORMAT",1,$L(X)) S A=AMQQXXSS D STRIP S AMQQXX("FORMAT")=A Q
I X=$E("SUBJECT",1,$L(X)) D SUBJECT Q
S %=$P(X," ")
I %=$E("TAXONOMY",1,$L(%)) D TAX Q
Q
;
STRIP ; ENTRY POINT FROM AMQQ0
F Q:$E(A)'=" " S A=$E(A,2,999)
F Q:$E(A,$L(A))'=" " S A=$E(A,1,$L(A)-1)
Q
;
SUBJECT I $D(AMQQXX(0)) S AMQQFAIL=4 Q
S A=AMQQXXSS
D STRIP
S (X,AMQQXXSS)=A
I X?1"`"1.N,$D(^DPT($E(X,2,9),0)) S AMQQCCLS="P",AMQQONE=$P(^(0),U),AMQQXX(0)=X Q
D AUTO^AMQQ1
I Y=-1 S AMQQFAIL=3 Q
S AMQQXX(0)=Y
D NEW^AMQQ1
Q
;
TAX S A=$P(X," ",2,99)
D STRIP
I A="" S AMQQFAIL=5 Q
S AMQQXXTX=A
S A=AMQQXXSS
D STRIP
I A="" S AMQQFAIL=5 Q
S AMQQXXTI=0
D SETAX
S AMQQXXTN=AMQQXXGN
N AMQQXXGN
D PLUSTAX
S AMQQXXGN=AMQQXXTN
K AMQQXXTN,AMQQXXTI,AMQQXXTX
Q
;
PLUSTAX S AMQQXXGN=AMQQXXTN
F S AMQQXXGN=$O(@AMQQXXGG) Q:'AMQQXXGN S A=@AMQQXXGI Q:$E(A)'="+" S A=$E(A,2,999) D STRIP,SETAX
S AMQQXXTN=AMQQXXGN
Q
;
SETAX F AMQQXXTP=1:1 S %=$P(A,",",AMQQXXTP) Q:%="" S AMQQXXTI=AMQQXXTI+1,^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTX,AMQQXXTI)=%
Q
;
SAVE D ^AMQQCMPS
Q
;
AMQQQ ; IHS/CMI/THL - SCRIPT INTERFACE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 ;1:UNDEFINED OR ILLEGAL INPUT VARIABLE
+4 ;2:UNDEFINED OR ILLEGAL OUTPUT VARIABLE
+5 ;3:SUBJECT LOOKUP FAILED
+6 ;4:MORE THAN ONE SUBJECT
+7 ;5:UNABLE TO CREATE TAXONOMY
+8 ;6:ATTRIBUTE LOOKUP FAILED
+9 ;7:CONDITION LOOKUP FAILED
+10 ;8:FAILED TO FIND VALUE
+11 ;9:OR GROUP ERROR
+12 ;10:SUBQUERY ERROR
EN ; ENTRY POINT FROM SEARCH^AMQQ
+1 KILL AMQQFAIL
RUN FOR AMQQQRUN=1:1:6
DO @$PIECE("KILL;VAL;ANAL;^AMQQQ0;^AMQQQ2;^AMQQCMPL",";",AMQQQRUN)
IF $DATA(AMQQQUIT)
QUIT
IF $DATA(AMQQFAIL)
QUIT
EXIT DO KILL
+1 QUIT
+2 ;
KILL KILL AMQQXXAA,AMQQXXAS,AMQQXXAT,AMQQXXCC,AMQQXXVV,AMQQNECO,AMQQRUN,AMQQQ,%,A,Z
+1 KILL AMQQYYAT,AMQQXXGG,AMQQXXGO,AMQQXXGI,AMQQXXII,AMQQXXSS,AMQQXXXX
+2 KILL AMQQATN,AMQQATNM,AMQQCTXS,AMQQFTYP,AMQQPRST,AMQQSBCT,AMQQVCL
+3 KILL AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
+4 QUIT
+5 ;
VAL ; ENTRY POINT FROM AMQQE1
+1 SET X=AMQQXX
+2 DO TEST
+3 IF $DATA(AMQQFAIL)
QUIT
+4 DO TEST1
+5 IF $DATA(AMQQFAIL)
QUIT
+6 SET X=AMQQYY
+7 IF X[U
IF $PIECE(X,U)=+X
SET AMQV("OPTION")="SAVE"
GOTO VAL1
+8 DO TEST
+9 IF $DATA(AMQQFAIL)
SET AMQQFAIL=2
QUIT
VAL1 SET AMQQXXGO=AMQQYY_"AMQQXXGN)"
+1 SET AMQQNECO=""
+2 IF '$DATA(AMQV("OPTION"))
SET AMQV("OPTION")="LIST"
+3 QUIT
+4 ;
TEST SET %=$EXTRACT(X,$LENGTH(X))
+1 IF %'=","
IF %'="("
SET AMQQFAIL=1
QUIT
+2 SET %=$EXTRACT(X,1,$LENGTH(X)-1)
+3 SET Y=$EXTRACT(X,$LENGTH(X))
+4 SET Z=X
+5 IF Y=","
SET %=%_")"
+6 SET X="I "_%_"=1"
+7 DO ^DIM
+8 IF '$DATA(X)
SET AMQQFAIL=1
+9 QUIT
+10 ;
TEST1 SET Z=AMQQXX
+1 SET AMQQXXGG=Z_"AMQQXXGN)"
+2 IF $DATA(@(Z_"1,0)"))
SET AMQQXXGI=Z_"AMQQXXGN,0)"
QUIT
+3 IF $DATA(@(Z_"1)"))
SET AMQQXXGI=Z_"AMQQXXGN)"
QUIT
+4 SET AMQQFAIL=1
+5 QUIT
+6 ;
ANAL FOR AMQQXXGN=0:0
SET AMQQXXGN=$ORDER(@AMQQXXGG)
IF 'AMQQXXGN
QUIT
SET AMQQXXXX=@AMQQXXGI
DO A1
IF $DATA(AMQQFAIL)!($DATA(AMQQQUIT))
QUIT
+1 IF '$DATA(AMQQXX(0))
SET AMQQFAIL=3
+2 QUIT
+3 ;
A1 SET %=AMQQXXXX
+1 SET %=$PIECE(%,"**")
+2 IF %=""
QUIT
+3 IF $EXTRACT(%)="*"
IF $EXTRACT(%,2)'="*"
SET %=$EXTRACT(%,2,999)
SET X=$PIECE(%,"=")
SET AMQQXXSS=$PIECE(%,"=",2,99)
+4 IF '$TEST
QUIT
+5 SET A=X
+6 DO STRIP
+7 SET X=A
+8 IF X=""
SET AMQQFAIL=1
QUIT
+9 IF X=$EXTRACT("FORMAT",1,$LENGTH(X))
SET A=AMQQXXSS
DO STRIP
SET AMQQXX("FORMAT")=A
QUIT
+10 IF X=$EXTRACT("SUBJECT",1,$LENGTH(X))
DO SUBJECT
QUIT
+11 SET %=$PIECE(X," ")
+12 IF %=$EXTRACT("TAXONOMY",1,$LENGTH(%))
DO TAX
QUIT
+13 QUIT
+14 ;
STRIP ; ENTRY POINT FROM AMQQ0
+1 FOR
IF $EXTRACT(A)'=" "
QUIT
SET A=$EXTRACT(A,2,999)
+2 FOR
IF $EXTRACT(A,$LENGTH(A))'=" "
QUIT
SET A=$EXTRACT(A,1,$LENGTH(A)-1)
+3 QUIT
+4 ;
SUBJECT IF $DATA(AMQQXX(0))
SET AMQQFAIL=4
QUIT
+1 SET A=AMQQXXSS
+2 DO STRIP
+3 SET (X,AMQQXXSS)=A
+4 IF X?1"`"1.N
IF $DATA(^DPT($EXTRACT(X,2,9),0))
SET AMQQCCLS="P"
SET AMQQONE=$PIECE(^(0),U)
SET AMQQXX(0)=X
QUIT
+5 DO AUTO^AMQQ1
+6 IF Y=-1
SET AMQQFAIL=3
QUIT
+7 SET AMQQXX(0)=Y
+8 DO NEW^AMQQ1
+9 QUIT
+10 ;
TAX SET A=$PIECE(X," ",2,99)
+1 DO STRIP
+2 IF A=""
SET AMQQFAIL=5
QUIT
+3 SET AMQQXXTX=A
+4 SET A=AMQQXXSS
+5 DO STRIP
+6 IF A=""
SET AMQQFAIL=5
QUIT
+7 SET AMQQXXTI=0
+8 DO SETAX
+9 SET AMQQXXTN=AMQQXXGN
+10 NEW AMQQXXGN
+11 DO PLUSTAX
+12 SET AMQQXXGN=AMQQXXTN
+13 KILL AMQQXXTN,AMQQXXTI,AMQQXXTX
+14 QUIT
+15 ;
PLUSTAX SET AMQQXXGN=AMQQXXTN
+1 FOR
SET AMQQXXGN=$ORDER(@AMQQXXGG)
IF 'AMQQXXGN
QUIT
SET A=@AMQQXXGI
IF $EXTRACT(A)'="+"
QUIT
SET A=$EXTRACT(A,2,999)
DO STRIP
DO SETAX
+2 SET AMQQXXTN=AMQQXXGN
+3 QUIT
+4 ;
SETAX FOR AMQQXXTP=1:1
SET %=$PIECE(A,",",AMQQXXTP)
IF %=""
QUIT
SET AMQQXXTI=AMQQXXTI+1
SET ^UTILITY("AMQQ",$JOB,"XXTAX",AMQQXXTX,AMQQXXTI)=%
+1 QUIT
+2 ;
SAVE DO ^AMQQCMPS
+1 QUIT
+2 ;
