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