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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEFIX 834 printed Sep 11, 2024@02:46:37 Page 2
PRSEFIX ;HIRMFO/MD-CHECK AND CORRECT CLASS REASON FIELD IN FILE 452. 21/2/95
+1 ;;4.0;PAID;**3**;SEP 13, 1995
+2 ; THIS ROUTINE ACCOMPANIES PATCH PRSE*4*3 AND SHOULD BE DELETED AFTER
+3 ; INSTALLATION OF PATCH PRS*4*3
+4 KILL ^PRSE(452.51,"SER")
+5 SET DA=0
FOR
SET DA=$ORDER(^PRSE(452,DA))
if DA'>0
QUIT
IF $DATA(^PRSE(452,DA,2))
if $RANDOM(800)
WRITE "."
Begin DoDot:1
+6 IF $DATA(^PRSE(452,DA,2,0))
SET D1=+$ORDER(^PRSE(452,DA,2,0))
SET PRSEX=+$GET(^PRSE(452,DA,2,+D1,0))
KILL ^PRSE(452,DA,2)
IF PRSEX
SET ^PRSE(452,DA,2)=PRSEX
KILL PRSEX
QUIT
+7 IF +$GET(^PRSE(452,DA,2))
IF $DATA(^PRSE(452.51,"B",+$GET(^PRSE(452,DA,2))))
QUIT
+8 IF +$GET(^PRSE(452,DA,2))
IF '$DATA(^PRSE(452,"B",+$GET(^PRSE(452,DA,2))))
SET ^PRSE(452,DA,2)=""
QUIT
+9 IF $GET(^PRSE(452,DA,2))'=""
SET PRSEX=$GET(^PRSE(452,DA,2))
SET ^PRSE(452,DA,2)=$SELECT($DATA(^PRSE(452.51,"B",PRSEX)):$ORDER(^PRSE(452.51,"B",PRSEX,0)),1:"")
+10 QUIT
End DoDot:1
+11 WRITE !!,$CHAR(7),"*** CHECK COMPLETED ***",!!
+12 QUIT
