source: WorldVistAEHR/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXPRE.m@ 700

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1AFJXPRE ;FO-OAKLAND/GMB-Pre/Post-init ;10/19/2001 07:29
2 ;;5.1;Network Health Exchange;**30,31**;Jan 23, 1996
3ENTER ;
4 D BMES^XPDUTL("Change Domain fields to point to file 4.2.")
5 I $D(^DD(537000,0,"ID","W8")) D Q
6 . D BMES^XPDUTL("Already done - we don't need to do it again.")
7 N AXCHANGE,AXLAST10
8 S AXLAST10=$O(^AFJ(537010,99999999999999),-1)
9 D FILE000
10 D FILE025
11 D:$G(AXCHANGE) FILE010
12 D DD000
13 Q
14FILE000 ;
15 D BMES^XPDUTL("File 537000: Change field 8 from free text to point to file 4.2")
16 N AXCNT,AXREF,AXIEN,AXDOM,AXDOMSAV,AXDOMIEN,XPDIDTOT
17 S XPDIDTOT=0
18 D UPDATE^XPDID(0)
19 S XPDIDTOT=$P(^AFJ(537000,0),U,4)
20 D BMES^XPDUTL("Change "_XPDIDTOT_" records...")
21 S (AXREF,AXDOMSAV)="",(AXIEN,AXCNT)=0
22 F S AXREF=$O(^AFJ(537000,"C",AXREF)) Q:AXREF="" D
23 . F S AXIEN=$O(^AFJ(537000,"C",AXREF,AXIEN)) Q:'AXIEN D
24 . . S AXCNT=AXCNT+1
25 . . I AXCNT#1000=0 D UPDATE^XPDID(AXCNT)
26 . . Q:+AXREF=AXREF
27 . . S AXDOM=$P($G(^AFJ(537000,AXIEN,1)),U)
28 . . I AXDOM="" K ^AFJ(537000,"C",AXREF,AXIEN)
29 . . I AXDOM'=AXDOMSAV D
30 . . . S AXDOMSAV=AXDOM
31 . . . S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXDOM,"B^C")
32 . . ; *** What if AXDOMIEN=0? ***
33 . . S DIE="^AFJ(537000,",DA=AXIEN,DR="8////"_AXDOMIEN
34 . . D ^DIE
35 D UPDATE^XPDID(XPDIDTOT)
36 D BMES^XPDUTL(AXCNT_" records in file 537000.")
37 I AXCNT'=$P(^AFJ(537000,0),U,4) D
38 . D MES^XPDUTL("Changing the count in the zero node in file 537000 from "_$P(^AFJ(537000,0),U,4)_" to "_AXCNT_".")
39 . S $P(^AFJ(537000,0),U,4)=AXCNT
40 D BMES^XPDUTL("File 537000: Let's check our work...")
41 S AXREF=":"
42 F S AXREF=$O(^AFJ(537000,"C",AXREF)) Q:AXREF="" K ^(AXREF)
43 S XPDIDTOT=0
44 D UPDATE^XPDID(0)
45 S XPDIDTOT=$P(^AFJ(537000,0),U,4)
46 S (AXIEN,AXCNT)=0
47 F S AXIEN=$O(^AFJ(537000,AXIEN)) Q:'AXIEN D
48 . S AXCNT=AXCNT+1
49 . I AXCNT#1000=0 D UPDATE^XPDID(AXCNT)
50 . S AXDOM=$P($G(^AFJ(537000,AXIEN,1)),U)
51 . Q:+AXDOM=AXDOM
52 . Q:AXDOM=""
53 . S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXDOM,"B^C")
54 . ; *** What if AXDOMIEN=0? ***
55 . S DIE="^AFJ(537000,",DA=AXIEN,DR="8////"_AXDOMIEN
56 . D ^DIE
57 D UPDATE^XPDID(XPDIDTOT)
58 D BMES^XPDUTL(AXCNT_" records in file 537000.")
59 I AXCNT=$P(^AFJ(537000,0),U,4) Q
60 D MES^XPDUTL("Changing the count in the zero node in file 537000 from "_$P(^AFJ(537000,0),U,4)_" to "_AXCNT_".")
61 S $P(^AFJ(537000,0),U,4)=AXCNT
62 Q
63FILE025 ;
64 D BMES^XPDUTL("File 537025: Change field .01 from free text to point to file 4.2")
65 N AXCNT,AXIEN,AXDOM,AXDOMIEN,XPDIDTOT
66 S XPDIDTOT=0
67 D UPDATE^XPDID(0)
68 S XPDIDTOT=$P(^AFJ(537025,0),U,4)
69 D BMES^XPDUTL("Change "_XPDIDTOT_" records...")
70 S (AXIEN,AXCNT)=0
71 F S AXIEN=$O(^AFJ(537025,AXIEN)) Q:'AXIEN D
72 . S AXCNT=AXCNT+1
73 . D UPDATE^XPDID(AXCNT)
74 . S AXDOM=$P(^AFJ(537025,AXIEN,0),U)
75 . Q:+AXDOM=AXDOM
76 . S AXCHANGE=1
77 . S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXDOM,"B^C")
78 . I AXDOMIEN D Q
79 . . S AXCHANGE(AXIEN)=AXDOMIEN
80 . . S DIE="^AFJ(537025,",DA=AXIEN,DR=".01////"_AXDOMIEN
81 . . D ^DIE
82 . S AXCNT=AXCNT-1
83 . S DIK="^AFJ(537025,",DA=AXIEN D ^DIK
84 D UPDATE^XPDID(XPDIDTOT)
85 D BMES^XPDUTL(AXCNT_" records in file 537025.")
86 I AXCNT=$P(^AFJ(537025,0),U,4) Q
87 D MES^XPDUTL("Changing the count in the zero node in file 537025 from "_$P(^AFJ(537025,0),U,4)_" to "_AXCNT_".")
88 S $P(^AFJ(537025,0),U,4)=AXCNT
89 Q
90FILE010 ;
91 D BMES^XPDUTL("File 537010: Change field .01 in the 'Records Available At' multiple")
92 D MES^XPDUTL("from pointing to file 537025 to point to file 4.2")
93 N AXCNT,AXPT,AXPTR,AXDOMIEN,XPDIDTOT
94 S XPDIDTOT=0
95 D UPDATE^XPDID(0)
96 S XPDIDTOT=$P(^AFJ(537010,0),U,4)
97 D BMES^XPDUTL("Change "_XPDIDTOT_" records...")
98 S (AXPT,AXCNT)=0
99 F S AXPT=$O(^AFJ(537010,AXPT)) Q:'AXPT D
100 . S AXCNT=AXCNT+1
101 . I AXCNT#1000=0 D UPDATE^XPDID(AXCNT)
102 . Q:AXPT>AXLAST10
103 . S AXIEN=0
104 . F S AXIEN=$O(^AFJ(537010,AXPT,1,AXIEN)) Q:'AXIEN D
105 . . S AXPTR=+$P($G(^AFJ(537010,AXPT,1,AXIEN,0)),U)
106 . . I $D(AXCHANGE(AXPTR)) D Q
107 . . . N AXFDA
108 . . . S AXFDA(537010.04,AXIEN_","_AXPT_",",.01)=AXCHANGE(AXPTR)
109 . . . D FILE^DIE("","AXFDA")
110 . . S DA(1)=AXPT,DA=AXIEN
111 . . S DIK="^AFJ(537010,"_AXPT_",1,"
112 . . D ^DIK
113 D UPDATE^XPDID(XPDIDTOT)
114 D BMES^XPDUTL(AXCNT_" records in file 537010.")
115 I AXCNT=$P(^AFJ(537010,0),U,4) Q
116 D MES^XPDUTL("Changing the count in the zero node in file 537010 from "_$P(^AFJ(537010,0),U,4)_" to "_AXCNT_".")
117 S $P(^AFJ(537010,0),U,4)=AXCNT
118 Q
119DD000 ;
120 D BMES^XPDUTL("Change identifiers in file 537000 to write identifiers.")
121 K ^DD(537000,0,"ID",1)
122 K ^DD(537000,0,"ID",3)
123 K ^DD(537000,0,"ID",7)
124 K ^DD(537000,0,"ID",8)
125 S ^DD(537000,0,"ID","W1")="N AX S AX=$P(^(0),U,2) D EN^DDIOL($E(AX,4,5)_""-""_$E(AX,6,7)_""-""_$E(AX,2,3),"""",""?0"")"
126 S ^DD(537000,0,"ID","W3")="D EN^DDIOL($P(^(0),U,4),"""",""?0"")"
127 S ^DD(537000,0,"ID","W7")="D EN^DDIOL($P(^(0),U,8),"""",""?0"")"
128 S ^DD(537000,0,"ID","W8")="D EN^DDIOL($$GET1^DIQ(537000,Y_"","",8),"""",""?0"")"
129 Q
Note: See TracBrowser for help on using the repository browser.