- 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 ;
