| 1 | DDPA2 ;SFISC/TKW FIND NON-CANONIC SORT RANGES WITH NO ASK NODE ;8/8/95 10:46
|
|---|
| 2 | V ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ; This routine will find any sort templates that have a sort field
|
|---|
| 5 | ; with a range that is FROM or TO a non-canonic number, has no
|
|---|
| 6 | ; ASK node, and that has
|
|---|
| 7 | ; had an extra space inserted by FM21 prior to patch DI*21*9.
|
|---|
| 8 | N I,J,X,Y,DIR,DIERR,DTOUT,DIRUT,DIROUT,DUOUT
|
|---|
| 9 | W !!,"This routine will report any sort templates that have been corrupted due to",!,"a bug in FM21 that has been repaired by patch DI*21*9.",!!
|
|---|
| 10 | W "If any templates are reported here, you can repair them by editing the template,",!,"without changing any of the sort fields.",!
|
|---|
| 11 | S DIR("?",1)="This routine will report any sort templates that may have been corrupted.",DIR("?",2)="If none show on the report, it means that none of the templates on your system"
|
|---|
| 12 | S DIR("?")="needed to be edited."
|
|---|
| 13 | S DIR(0)="Y",DIR("A")="Report corrupted sort templates",DIR("B")="Yes" D ^DIR K DIR Q:Y'=1
|
|---|
| 14 | W !!,"Searching Sort Template file...please wait",!!,"Report of templates that need to be repaired",!!
|
|---|
| 15 | F I=0:0 S I=$O(^DIBT(I)) Q:'I S X=$P($G(^(I,0)),U) D
|
|---|
| 16 | . S DIERR=0 F J=0:0 Q:DIERR=1 S J=$O(^DIBT(I,2,J)) Q:'J I $P($G(^(J,0)),U,10)=4,'$G(^("ASK")),$G(^("SRTTXT"))]"" D
|
|---|
| 17 | .. S Y=$P($G(^DIBT(I,2,J,"F")),U,2) I Y?1." "1.E S DIERR=1 Q
|
|---|
| 18 | .. S Y=$P($G(^DIBT(I,2,J,"T")),U,2) I Y?1." "1.E S DIERR=1 Q
|
|---|
| 19 | .. Q
|
|---|
| 20 | . I DIERR=1 W "No. "_I_" Name: "_X,!
|
|---|
| 21 | . Q
|
|---|
| 22 | Q
|
|---|
