| [613] | 1 | PRSEFIX ;HIRMFO/MD-CHECK AND CORRECT CLASS REASON FIELD IN FILE 452. 21/2/95
|
|---|
| 2 | ;;4.0;PAID;**3**;SEP 13, 1995
|
|---|
| 3 | ; THIS ROUTINE ACCOMPANIES PATCH PRSE*4*3 AND SHOULD BE DELETED AFTER
|
|---|
| 4 | ; INSTALLATION OF PATCH PRS*4*3
|
|---|
| 5 | K ^PRSE(452.51,"SER")
|
|---|
| 6 | S DA=0 F S DA=$O(^PRSE(452,DA)) Q:DA'>0 I $D(^PRSE(452,DA,2)) W:$R(800) "." D
|
|---|
| 7 | . I $D(^PRSE(452,DA,2,0)) S D1=+$O(^PRSE(452,DA,2,0)),PRSEX=+$G(^PRSE(452,DA,2,+D1,0)) K ^PRSE(452,DA,2) I PRSEX S ^PRSE(452,DA,2)=PRSEX K PRSEX Q
|
|---|
| 8 | . I +$G(^PRSE(452,DA,2)),$D(^PRSE(452.51,"B",+$G(^PRSE(452,DA,2)))) Q
|
|---|
| 9 | . I +$G(^PRSE(452,DA,2)),'$D(^PRSE(452,"B",+$G(^PRSE(452,DA,2)))) S ^PRSE(452,DA,2)="" Q
|
|---|
| 10 | . I $G(^PRSE(452,DA,2))'="" S PRSEX=$G(^PRSE(452,DA,2)) S ^PRSE(452,DA,2)=$S($D(^PRSE(452.51,"B",PRSEX)):$O(^PRSE(452.51,"B",PRSEX,0)),1:"")
|
|---|
| 11 | . Q
|
|---|
| 12 | W !!,$C(7),"*** CHECK COMPLETED ***",!!
|
|---|
| 13 | Q
|
|---|
