| 1 | AFJXPRE ;FO-OAKLAND/GMB-Pre/Post-init ;10/19/2001 07:29
|
---|
| 2 | ;;5.1;Network Health Exchange;**30,31**;Jan 23, 1996
|
---|
| 3 | ENTER ;
|
---|
| 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
|
---|
| 14 | FILE000 ;
|
---|
| 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
|
---|
| 63 | FILE025 ;
|
---|
| 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
|
---|
| 90 | FILE010 ;
|
---|
| 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
|
---|
| 119 | DD000 ;
|
---|
| 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
|
---|