14 lines
821 B
Mathematica
14 lines
821 B
Mathematica
PRSEFIX ;HIRMFO/MD-CHECK AND CORRECT CLASS REASON FIELD IN FILE 452. 21/2/95
|
|
;;4.0;PAID;**3**;SEP 13, 1995
|
|
; THIS ROUTINE ACCOMPANIES PATCH PRSE*4*3 AND SHOULD BE DELETED AFTER
|
|
; INSTALLATION OF PATCH PRS*4*3
|
|
K ^PRSE(452.51,"SER")
|
|
S DA=0 F S DA=$O(^PRSE(452,DA)) Q:DA'>0 I $D(^PRSE(452,DA,2)) W:$R(800) "." D
|
|
. 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
|
|
. I +$G(^PRSE(452,DA,2)),$D(^PRSE(452.51,"B",+$G(^PRSE(452,DA,2)))) Q
|
|
. I +$G(^PRSE(452,DA,2)),'$D(^PRSE(452,"B",+$G(^PRSE(452,DA,2)))) S ^PRSE(452,DA,2)="" Q
|
|
. 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:"")
|
|
. Q
|
|
W !!,$C(7),"*** CHECK COMPLETED ***",!!
|
|
Q
|