AMQQN2 ; IHS/CMI/THL - TEMP ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
VAR N A,S
S A=X
S S=" "
N %,X,Y,Z
RUN D ATT
I $G(Y)=-1 S AMQQFAIL=5 G EXIT
I A="",$D(AMQQONE),"GL"[$P(^AMQQ(4,AMQQNTYP,0),U) S A="= ALL"
I A="" S AMQQNCND="",AMQQNVAL=""
E D COND I Y=-1 S AMQQFAIL=5 G EXIT
I $G(AMQQNSUB)'="" D SUB I Y=-1 S AMQQFAIL=6 G EXIT
EXIT K AMQQNI,AMQQNOTF,AMQQNTYP,AMQQNII,%,A,S
Q
;
ATT S DIC="^AMQQ(5,"
S DIC(0)="ES"
S DIC("S")="I $P(^(0),U,2)=AMQQCCLS"
F AMQQNI=1:1:$L(A,S)-1 S X=$P(A,S,AMQQNI,AMQQNI+1) Q:X="" S:$E(X,$L(X))="S" X=$E(X,1,$L(X)-1) S D="C" I X'=+X D IX^DIC I Y'=-1 S X=$P(A,S,AMQQNI,AMQQNI+1) D ATTSET G ATTEXIT
F AMQQNI=1:1 S X=$P(A,S,AMQQNI) Q:X="" S:$E(X,$L(X))="S" X=$E(X,1,$L(X)-1) S D="C" I X'="LAST",X'=+X D IX^DIC I Y'=-1 S X=$P(A,S,AMQQNI) D ATTSET Q
ATTEXIT K DIC
Q
;
ATTSET D ^AMQQSEC
I Y=-1 S AMQQNSF="" H 2 Q
S AMQQNSUB=$P(A,X)
S %=$L(AMQQNSUB)
I $E(AMQQNSUB,%)=" " S AMQQNSUB=$E(AMQQNSUB,1,%-1)
S A=$P(A,X,2,99)
I $E(A)=S S A=$E(A,2,999)
S AMQQNATT=Y
S AMQQATN=+Y
S AMQQATNM=$P(Y,U,2)
S AMQQLINK=$P(^AMQQ(5,+Y,0),U,5)
I 'AMQQLINK S Y=-1 Q
I AMQQATN>1000 D ^AMQQATAL
W $C(13),?79,$C(13)
S %=$P(^AMQQ(5,+Y,0),U,5)
S:%=9 %=+Y+($J/100000)
S AMQQNTYP=$P(^AMQQ(1,%,0),U,5)
S AMQQCTXS=$P(^(0),U,7)
Q
;
COND S %=$P(^AMQQ(4,AMQQNTYP,0),U)
I "GL"[% D TAX Q
S %=$P(A,S)
I "^IS^WAS^ARE^WERE^"[(U_%_U) S AMQQNISF="",A=$P(A,S,2,99) G COND
I "^`^NOT^"[% S AMQQNOTF="",A=$P(A,S,2,99)
C1 S DIC="^AMQQ(5,"
S DIC(0)="ES"
I 'AMQQCTXS S DIC("S")="I $P(^(0),U,3)=AMQQNTYP" G C2
I $G(AMQQNSUB)'="" S DIC("S")="I $P(^(0),U,21)="_AMQQNTYP G C2
S AMQQSQST=$P(^AMQQ(4,AMQQNTYP,0),U)
D DICS^AMQQSQAC
C2 S %=$L(A,S)
I %>3 S %=3
S AMQQNII=%
F AMQQNI=AMQQNII:-1:1 S X=$P(A,S,1,AMQQNI),D="C" D IX^DIC I Y'=-1 Q
W $C(13),?79,$C(13)
K DIC
I Y=-1,$D(AMQQNISF) K AMQQNISF S A="= "_A G C1
I Y=-1 Q
S AMQQNVAL=$P(A," ",AMQQNI+1,99)
S AMQQNCND=Y
S %=$L(AMQQNVAL,S)
I %>1,$P(AMQQNVAL,S,%-1)=+$P(AMQQNVAL,S,%-1) S AMQQNVAL=$P(AMQQNVAL,S,1,%-1)
I $D(AMQQNOTF) K AMQQNOTF S $P(AMQQNCND,U,3)="'"
I $G(AMQQNVAL)'="" D VAL
Q
;
TAX F %="IS","WAS","ARE","WERE" I $P(A," ")=% S A="= "_$P(A," ",2,99)
S AMQQNVAL=$P(A,"= ",2)
S AMQQNTAX=AMQQNVAL
K AMQQTAX
S %=^AMQQ(5,+Y,0)
S AMQQLINK=$P(%,U,5)
S AMQQTNAR=$P(%,U,15)
S AMQQTDIC=U_$P(%,U,16)
S AMQQTLOK=U_$P(%,U,18)
S AMQQTTX=""
S:$D(^AMQQ(5,+Y,3)) AMQQTTX=^(3)
D ^AMQQTX
W $C(13),?79,$C(13)
I '$D(AMQQTAX) S AMQQFAIL=8 Q
S AMQQNCND=$S(AMQQCTXS:"MTAX",1:"TAX")
S AMQQNVAL=AMQQTAX
I $D(AMQQXXXX),AMQQXXXX["'="!(AMQQXXXX[" NOT ") S ^UTILITY("AMQQ TAX",$J,AMQQTAX,"--")=""
Q
;
SUB S A=AMQQNSUB
S DIC="^AMQQ(5,"
S DIC(0)="ES"
S DIC("S")="I $P(^(0),U,20)=""C""!($P(^(0),U,20)=""O""),$P(^(0),U,21)="_AMQQNTYP_"!($P(^(0),U,21)=16)"
S %=$L(A,S)
I %>3 S %=3
S AMQQNII=%
F AMQQNI=AMQQNII:-1:1 S X=$P(A,S,1,AMQQNI),D="C" D IX^DIC I Y'=-1 Q
W $C(13),?79,$C(13)
K DIC
I Y=-1 S AMQQFAIL=10 Q
S X=$P(A,S,1,AMQQNI)
S %=$P(A,X,2)
S AMQQNSTP=$P(^AMQQ(5,+Y,0),U,20)
S %=$TR(%," ","")
I AMQQNSTP="C",%'="" S AMQQFAIL=10 Q
I AMQQNSTP="C",$G(AMQQNCND)="MTAX" S AMQQFAIL=10 Q
I AMQQNSTP="C" S AMQQNSCD=Y Q
I %="" S %=1
I %'=+% S AMQQFAIL=10 Q
S AMQQNSCD=Y
S AMQQNSVL=%
Q
;
VAL K AMQQCOMP
S X=AMQQNVAL
S AMQQFTYP=$P(^AMQQ(4,AMQQNTYP,0),U)
S AMQQNOCO=1
S AMQQSYMB=$P(^AMQQ(5,AMQQATN,0),U,6)
I AMQQCTXS S %=$P(^AMQQ(5,+AMQQNCND,0),U,21),AMQQFTYP=$P(^AMQQ(4,%,0),U)
I $D(AMQQNV2) S X=X_";"_AMQQNV2,AMQQNOCO=2 K AMQQNV2
D ^AMQQAV
I $G(AMQQCOMP)="" S AMQQFAIL=6 Q
S AMQQNVAL=AMQQCOMP
K AMQQCOMP
Q
;
AMQQN2 ; IHS/CMI/THL - TEMP ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
VAR NEW A,S
+1 SET A=X
+2 SET S=" "
+3 NEW %,X,Y,Z
RUN DO ATT
+1 IF $GET(Y)=-1
SET AMQQFAIL=5
GOTO EXIT
+2 IF A=""
IF $DATA(AMQQONE)
IF "GL"[$PIECE(^AMQQ(4,AMQQNTYP,0),U)
SET A="= ALL"
+3 IF A=""
SET AMQQNCND=""
SET AMQQNVAL=""
+4 IF '$TEST
DO COND
IF Y=-1
SET AMQQFAIL=5
GOTO EXIT
+5 IF $GET(AMQQNSUB)'=""
DO SUB
IF Y=-1
SET AMQQFAIL=6
GOTO EXIT
EXIT KILL AMQQNI,AMQQNOTF,AMQQNTYP,AMQQNII,%,A,S
+1 QUIT
+2 ;
ATT SET DIC="^AMQQ(5,"
+1 SET DIC(0)="ES"
+2 SET DIC("S")="I $P(^(0),U,2)=AMQQCCLS"
+3 FOR AMQQNI=1:1:$LENGTH(A,S)-1
SET X=$PIECE(A,S,AMQQNI,AMQQNI+1)
IF X=""
QUIT
IF $EXTRACT(X,$LENGTH(X))="S"
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
SET D="C"
IF X'=+X
DO IX^DIC
IF Y'=-1
SET X=$PIECE(A,S,AMQQNI,AMQQNI+1)
DO ATTSET
GOTO ATTEXIT
+4 FOR AMQQNI=1:1
SET X=$PIECE(A,S,AMQQNI)
IF X=""
QUIT
IF $EXTRACT(X,$LENGTH(X))="S"
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
SET D="C"
IF X'="LAST"
IF X'=+X
DO IX^DIC
IF Y'=-1
SET X=$PIECE(A,S,AMQQNI)
DO ATTSET
QUIT
ATTEXIT KILL DIC
+1 QUIT
+2 ;
ATTSET DO ^AMQQSEC
+1 IF Y=-1
SET AMQQNSF=""
HANG 2
QUIT
+2 SET AMQQNSUB=$PIECE(A,X)
+3 SET %=$LENGTH(AMQQNSUB)
+4 IF $EXTRACT(AMQQNSUB,%)=" "
SET AMQQNSUB=$EXTRACT(AMQQNSUB,1,%-1)
+5 SET A=$PIECE(A,X,2,99)
+6 IF $EXTRACT(A)=S
SET A=$EXTRACT(A,2,999)
+7 SET AMQQNATT=Y
+8 SET AMQQATN=+Y
+9 SET AMQQATNM=$PIECE(Y,U,2)
+10 SET AMQQLINK=$PIECE(^AMQQ(5,+Y,0),U,5)
+11 IF 'AMQQLINK
SET Y=-1
QUIT
+12 IF AMQQATN>1000
DO ^AMQQATAL
+13 WRITE $CHAR(13),?79,$CHAR(13)
+14 SET %=$PIECE(^AMQQ(5,+Y,0),U,5)
+15 IF %=9
SET %=+Y+($JOB/100000)
+16 SET AMQQNTYP=$PIECE(^AMQQ(1,%,0),U,5)
+17 SET AMQQCTXS=$PIECE(^(0),U,7)
+18 QUIT
+19 ;
COND SET %=$PIECE(^AMQQ(4,AMQQNTYP,0),U)
+1 IF "GL"[%
DO TAX
QUIT
+2 SET %=$PIECE(A,S)
+3 IF "^IS^WAS^ARE^WERE^"[(U_%_U)
SET AMQQNISF=""
SET A=$PIECE(A,S,2,99)
GOTO COND
+4 IF "^`^NOT^"[%
SET AMQQNOTF=""
SET A=$PIECE(A,S,2,99)
C1 SET DIC="^AMQQ(5,"
+1 SET DIC(0)="ES"
+2 IF 'AMQQCTXS
SET DIC("S")="I $P(^(0),U,3)=AMQQNTYP"
GOTO C2
+3 IF $GET(AMQQNSUB)'=""
SET DIC("S")="I $P(^(0),U,21)="_AMQQNTYP
GOTO C2
+4 SET AMQQSQST=$PIECE(^AMQQ(4,AMQQNTYP,0),U)
+5 DO DICS^AMQQSQAC
C2 SET %=$LENGTH(A,S)
+1 IF %>3
SET %=3
+2 SET AMQQNII=%
+3 FOR AMQQNI=AMQQNII:-1:1
SET X=$PIECE(A,S,1,AMQQNI)
SET D="C"
DO IX^DIC
IF Y'=-1
QUIT
+4 WRITE $CHAR(13),?79,$CHAR(13)
+5 KILL DIC
+6 IF Y=-1
IF $DATA(AMQQNISF)
KILL AMQQNISF
SET A="= "_A
GOTO C1
+7 IF Y=-1
QUIT
+8 SET AMQQNVAL=$PIECE(A," ",AMQQNI+1,99)
+9 SET AMQQNCND=Y
+10 SET %=$LENGTH(AMQQNVAL,S)
+11 IF %>1
IF $PIECE(AMQQNVAL,S,%-1)=+$PIECE(AMQQNVAL,S,%-1)
SET AMQQNVAL=$PIECE(AMQQNVAL,S,1,%-1)
+12 IF $DATA(AMQQNOTF)
KILL AMQQNOTF
SET $PIECE(AMQQNCND,U,3)="'"
+13 IF $GET(AMQQNVAL)'=""
DO VAL
+14 QUIT
+15 ;
TAX FOR %="IS","WAS","ARE","WERE"
IF $PIECE(A," ")=%
SET A="= "_$PIECE(A," ",2,99)
+1 SET AMQQNVAL=$PIECE(A,"= ",2)
+2 SET AMQQNTAX=AMQQNVAL
+3 KILL AMQQTAX
+4 SET %=^AMQQ(5,+Y,0)
+5 SET AMQQLINK=$PIECE(%,U,5)
+6 SET AMQQTNAR=$PIECE(%,U,15)
+7 SET AMQQTDIC=U_$PIECE(%,U,16)
+8 SET AMQQTLOK=U_$PIECE(%,U,18)
+9 SET AMQQTTX=""
+10 IF $DATA(^AMQQ(5,+Y,3))
SET AMQQTTX=^(3)
+11 DO ^AMQQTX
+12 WRITE $CHAR(13),?79,$CHAR(13)
+13 IF '$DATA(AMQQTAX)
SET AMQQFAIL=8
QUIT
+14 SET AMQQNCND=$SELECT(AMQQCTXS:"MTAX",1:"TAX")
+15 SET AMQQNVAL=AMQQTAX
+16 IF $DATA(AMQQXXXX)
IF AMQQXXXX["'="!(AMQQXXXX[" NOT ")
SET ^UTILITY("AMQQ TAX",$JOB,AMQQTAX,"--")=""
+17 QUIT
+18 ;
SUB SET A=AMQQNSUB
+1 SET DIC="^AMQQ(5,"
+2 SET DIC(0)="ES"
+3 SET DIC("S")="I $P(^(0),U,20)=""C""!($P(^(0),U,20)=""O""),$P(^(0),U,21)="_AMQQNTYP_"!($P(^(0),U,21)=16)"
+4 SET %=$LENGTH(A,S)
+5 IF %>3
SET %=3
+6 SET AMQQNII=%
+7 FOR AMQQNI=AMQQNII:-1:1
SET X=$PIECE(A,S,1,AMQQNI)
SET D="C"
DO IX^DIC
IF Y'=-1
QUIT
+8 WRITE $CHAR(13),?79,$CHAR(13)
+9 KILL DIC
+10 IF Y=-1
SET AMQQFAIL=10
QUIT
+11 SET X=$PIECE(A,S,1,AMQQNI)
+12 SET %=$PIECE(A,X,2)
+13 SET AMQQNSTP=$PIECE(^AMQQ(5,+Y,0),U,20)
+14 SET %=$TRANSLATE(%," ","")
+15 IF AMQQNSTP="C"
IF %'=""
SET AMQQFAIL=10
QUIT
+16 IF AMQQNSTP="C"
IF $GET(AMQQNCND)="MTAX"
SET AMQQFAIL=10
QUIT
+17 IF AMQQNSTP="C"
SET AMQQNSCD=Y
QUIT
+18 IF %=""
SET %=1
+19 IF %'=+%
SET AMQQFAIL=10
QUIT
+20 SET AMQQNSCD=Y
+21 SET AMQQNSVL=%
+22 QUIT
+23 ;
VAL KILL AMQQCOMP
+1 SET X=AMQQNVAL
+2 SET AMQQFTYP=$PIECE(^AMQQ(4,AMQQNTYP,0),U)
+3 SET AMQQNOCO=1
+4 SET AMQQSYMB=$PIECE(^AMQQ(5,AMQQATN,0),U,6)
+5 IF AMQQCTXS
SET %=$PIECE(^AMQQ(5,+AMQQNCND,0),U,21)
SET AMQQFTYP=$PIECE(^AMQQ(4,%,0),U)
+6 IF $DATA(AMQQNV2)
SET X=X_";"_AMQQNV2
SET AMQQNOCO=2
KILL AMQQNV2
+7 DO ^AMQQAV
+8 IF $GET(AMQQCOMP)=""
SET AMQQFAIL=6
QUIT
+9 SET AMQQNVAL=AMQQCOMP
+10 KILL AMQQCOMP
+11 QUIT
+12 ;
