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

DGYM78PT.m

Go to the documentation of this file.
  1. DGYM78PT ;ALB/MLI - Post-install routine for DG*5.3*78 ; 3/4/96@925
  1. ;;5.3;Registration;**78,1015**;Aug 13, 1993;Build 21
  1. ;
  1. ; This post-install routine will check the Medical Center Division
  1. ; file to ensure that each entry has a unique pointer to the
  1. ; Institution file. It will also delete the .001 field in the
  1. ; Eligibility code file (#8) if one exists.
  1. ;
  1. EN ; begin processing
  1. D ELIG
  1. D DIV
  1. Q
  1. ;
  1. ;
  1. ELIG ; look for .001 field in file 8...delete if there
  1. N DA,DIK
  1. I $D(^DD(8,.001)) D
  1. . D BMES^XPDUTL(">>> .001 Field of Eligibility code file found and deleted...")
  1. . S DIK="^DD(8,",DA=.001,DA(1)=8
  1. . D ^DIK
  1. Q
  1. ;
  1. ;
  1. DIV ; search for problems with medical center division/institution relationship
  1. N CT,I,X
  1. D BMES^XPDUTL(">>> Searching for entries in the Medical Center Division file that")
  1. D MES^XPDUTL(" don't have a pointer to the Institution file...")
  1. S (CT,I)=0 F S I=$O(^DG(40.8,I)) Q:'I D
  1. . S X=$G(^DG(40.8,I,0))
  1. . I $G(^DIC(4,+$P(X,"^",7),0))']"" D
  1. . . D DIVNAME(I)
  1. . . S CT=CT+1
  1. I 'CT D MES^XPDUTL(" All divisions ok. No problems found!")
  1. ;
  1. ;
  1. D BMES^XPDUTL(">>> Searching for entries in the Medical Center Division file that")
  1. D MES^XPDUTL(" point to the same Institution file entry...")
  1. S (CT,I)=0 F S I=$O(^DG(40.8,"AD",I)) Q:'I D
  1. . S X=$O(^DG(40.8,"AD",I,0))
  1. . I '$O(^DG(40.8,"AD",I,X)) Q ; no duplicate pointers
  1. . S J=0 F S J=$O(^DG(40.8,"AD",I,J)) Q:'J D
  1. . . S CT=CT+1
  1. . . D DIVNAME(J)
  1. I 'CT D MES^XPDUTL(" All divisions ok. No problems found!")
  1. Q
  1. ;
  1. ;
  1. DIVNAME(IEN) ; print out division with institution pointer
  1. ;
  1. ; input - IEN as IEN of the entry in the Medical Center Division file.
  1. ;
  1. N X,Y
  1. S X=$G(^DG(40.8,+IEN,0)),Y=$P($G(^DIC(4,+$P(X,"^",7),0)),"^",1)
  1. S STRING=$S($P(X,"^",1)]"":$P(X,"^",1),1:"UNKNOWN DIVISION")_" (IEN #"_IEN_")"
  1. S STRING=STRING_" points to "_$S(Y]"":Y_" institution (IEN #"_+$P(X,"^",7)_")",1:"no institution")
  1. D MES^XPDUTL(STRING)
  1. Q