source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYM78PT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1DGYM78PT ;ALB/MLI - Post-install routine for DG*5.3*78 ; 3/4/96@925
2 ;;5.3;Registration;**78**;Aug 13, 1993
3 ;
4 ; This post-install routine will check the Medical Center Division
5 ; file to ensure that each entry has a unique pointer to the
6 ; Institution file. It will also delete the .001 field in the
7 ; Eligibility code file (#8) if one exists.
8 ;
9EN ; begin processing
10 D ELIG
11 D DIV
12 Q
13 ;
14 ;
15ELIG ; look for .001 field in file 8...delete if there
16 N DA,DIK
17 I $D(^DD(8,.001)) D
18 . D BMES^XPDUTL(">>> .001 Field of Eligibility code file found and deleted...")
19 . S DIK="^DD(8,",DA=.001,DA(1)=8
20 . D ^DIK
21 Q
22 ;
23 ;
24DIV ; search for problems with medical center division/institution relationship
25 N CT,I,X
26 D BMES^XPDUTL(">>> Searching for entries in the Medical Center Division file that")
27 D MES^XPDUTL(" don't have a pointer to the Institution file...")
28 S (CT,I)=0 F S I=$O(^DG(40.8,I)) Q:'I D
29 . S X=$G(^DG(40.8,I,0))
30 . I $G(^DIC(4,+$P(X,"^",7),0))']"" D
31 . . D DIVNAME(I)
32 . . S CT=CT+1
33 I 'CT D MES^XPDUTL(" All divisions ok. No problems found!")
34 ;
35 ;
36 D BMES^XPDUTL(">>> Searching for entries in the Medical Center Division file that")
37 D MES^XPDUTL(" point to the same Institution file entry...")
38 S (CT,I)=0 F S I=$O(^DG(40.8,"AD",I)) Q:'I D
39 . S X=$O(^DG(40.8,"AD",I,0))
40 . I '$O(^DG(40.8,"AD",I,X)) Q ; no duplicate pointers
41 . S J=0 F S J=$O(^DG(40.8,"AD",I,J)) Q:'J D
42 . . S CT=CT+1
43 . . D DIVNAME(J)
44 I 'CT D MES^XPDUTL(" All divisions ok. No problems found!")
45 Q
46 ;
47 ;
48DIVNAME(IEN) ; print out division with institution pointer
49 ;
50 ; input - IEN as IEN of the entry in the Medical Center Division file.
51 ;
52 N X,Y
53 S X=$G(^DG(40.8,+IEN,0)),Y=$P($G(^DIC(4,+$P(X,"^",7),0)),"^",1)
54 S STRING=$S($P(X,"^",1)]"":$P(X,"^",1),1:"UNKNOWN DIVISION")_" (IEN #"_IEN_")"
55 S STRING=STRING_" points to "_$S(Y]"":Y_" institution (IEN #"_+$P(X,"^",7)_")",1:"no institution")
56 D MES^XPDUTL(STRING)
57 Q
Note: See TracBrowser for help on using the repository browser.