Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSEFIX

PRSEFIX.m

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