- 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 Feb 18, 2025@23:53:11 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