| 1 | QAQAHOC5 ;WCIOFO/ERC-Continuation of QAQAHOC3 ;7/22/98
|
|---|
| 2 | ;;1.7;QM Integration Module;**5**;07/25/1995
|
|---|
| 3 | ;
|
|---|
| 4 | EDITMAC ;if the macro is not valid, display message explaining that user
|
|---|
| 5 | ;should enter the macro again, then either use the same name to
|
|---|
| 6 | ;replace the old macro with the current, valid one, or to use a
|
|---|
| 7 | ;new name.
|
|---|
| 8 | W !!,"Your macro is no longer valid. Re-enter the macro now, and"
|
|---|
| 9 | W !,"when finished enter '[S' to save it at the prompt for the next"
|
|---|
| 10 | W !,"field. Enter the old macro name if you want to replace it with"
|
|---|
| 11 | W !,"the new criteria, or enter a completely new name."
|
|---|
| 12 | S DIR(0)="E" D ^DIR K DIR
|
|---|
| 13 | S Y=0
|
|---|
| 14 | Q
|
|---|
| 15 | STRIP ;if there are qualifiers on QAQFLD,strip them off
|
|---|
| 16 | N X
|
|---|
| 17 | S QAQFLD1=""
|
|---|
| 18 | F X=1:1:$L(QAQFLD) I "'!@#&+-"[$E(QAQFLD) S QAQFLD1=QAQFLD1_$E(QAQFLD),QAQFLD=$E(QAQFLD,2,999)
|
|---|
| 19 | Q
|
|---|
| 20 | STRIP2 ;if there are qualifiers on QAQPF, strip them out before comparing
|
|---|
| 21 | ;to QAQPM
|
|---|
| 22 | N QAQFIRST,QAQLAST,QAQLNTH,QAQPFQUL,X
|
|---|
| 23 | S QAQPFQUL=""
|
|---|
| 24 | S (QAQCC,QAQFIRST)=0
|
|---|
| 25 | S QAQPFX=QAQPF
|
|---|
| 26 | F X=1:1:$L(QAQPFX) S:"'!@#&+-"[$E(QAQPFX) QAQLNTH(X)=X,QAQPFQUL=QAQPFQUL_$E(QAQPF,X) S QAQPFX=$E(QAQPFX,2,999)
|
|---|
| 27 | S QAQPM=$TR(QAQPM,"~")
|
|---|
| 28 | I $G(QAQPFQUL)]"" D
|
|---|
| 29 | . F S QAQCC=$O(QAQLNTH(QAQCC)) Q:QAQCC'>0 S:$G(QAQFIRST)<1 QAQFIRST=QAQCC S QAQLAST=QAQCC
|
|---|
| 30 | . I $G(QAQFIRST)>0 D
|
|---|
| 31 | . . S QAQPF1=$E(QAQPF,1,QAQFIRST-1)
|
|---|
| 32 | . . S QAQPF2=$E(QAQPF,QAQLAST+1,999)
|
|---|
| 33 | . . I $G(QAQPM)'=($G(QAQPF1)_$G(QAQPF2)) S QAQPF1=$G(QAQPM1),QAQPF2=$G(QAQPM2)
|
|---|
| 34 | . . S QAQPFALL=$G(QAQPF1)_$G(QAQPFQUL)_$G(QAQPF2)
|
|---|
| 35 | . . I $G(QAQPFEND)]"" S QAQPFALL=$G(QAQPFALL)_";"_$G(QAQPFEND)
|
|---|
| 36 | I $G(QAQPFQUL)']"" D
|
|---|
| 37 | . I $G(QAQPF)'=$G(QAQPM) S QAQPF=$G(QAQPM)
|
|---|
| 38 | . S QAQPFALL=$G(QAQPF)_$S($G(QAQPFEND)]"":";"_QAQPFEND,1:"")
|
|---|
| 39 | S $P(^QA(740.1,QAQD0,"FLD",QAQEE,0),U,2)=$G(QAQPFALL)
|
|---|
| 40 | Q
|
|---|
