PRSEFIX.m

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 ---PRSEFIX   834     printed  Apr 09, 2024@21:28:28                                                                                                                                                                                                      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