XU8P43P ;SF-OCIO/CJS - ASSOCIATE STATIONS TO VISNS ;6/27/98 23:20
;;8.0;KERNEL;**43**;
PRE ; PRE INSTALL FOR XU*8*43
I $G(^DD(4,14,0))']"ASSOCIATIONS^4.014P" D
. S DIK="^DD(4,",DA=14,DA(1)=4 D ^DIK
I $G(^DD(4.014,.01,1,2,0))["^AC" D
. S DIK="^DD(4.014,.01,1,",DA=2,DA(1)=.01,DA(2)=4 D ^DIK K ^DIC(4,"AC")
Q
POST ; POST INSTALL FOR XU*8*43
; FIRST, SET UP VISNS
N FDA,IEN S FDA(4.1,"?+1,",.01)="VISN",FDA(4.1,"?+1,",1)="VETERANS INTEGRATED SERVICE NETWORK"
D UPDATE^DIE("E","FDA","IEN")
N VISN,VIS F VISN=1:1:22 S VIS="VISN "_VISN I '$D(^DIC(4,"B",VIS)) D
. S FDA(4,"+1,",.01)=VIS,FDA(4,"+1,",13)="VISN"
. D UPDATE^DIE("E","FDA")
. Q
; SET UP TMP ARRAY OF ASSOCIATIONS
S I=0 F S I=I+1,VIS=$P($T(TABLE+I),";",3) Q:VIS="" S VIS($P($T(TABLE+I),";",4))=VIS
; LOOP THROUGH INSTITUTION FILE SETTING UP ASSOCIATIONS
N INST,SN S INST=0 F S INST=$O(^DIC(4,INST)) Q:INST'>0 S SN=+$G(^DIC(4,INST,99)) D:SN
. Q:'$D(VIS(SN))
. S FDA(4,"?1,",.01)="`"_INST
. S FDA(4.014,"+2,?1,",.01)=1,FDA(4.014,"+2,?1,",1)="VISN "_VIS(SN)
. D UPDATE^DIE("E","FDA")
. Q
Q
TABLE ;;
;;1;402
;;1;405
;;1;518
;;1;523
;;1;525
;;1;608
;;1;627
;;1;631
;;1;650
;;1;689
;;2;500
;;2;514
;;2;528
;;2;532
;;2;670
;;3;526
;;3;527
;;3;533
;;3;561
;;3;604
;;3;620
;;3;630
;;3;632
;;4;460
;;4;503
;;4;529
;;4;540
;;4;542
;;4;562
;;4;595
;;4;642
;;4;645
;;4;646
;;4;693
;;5;512
;;5;566
;;5;613
;;5;688
;;6;517
;;6;558
;;6;565
;;6;590
;;6;637
;;6;652
;;6;658
;;6;659
;;7;508
;;7;509
;;7;521
;;7;534
;;7;544
;;7;557
;;7;619
;;7;679
;;7;680
;;7;766
;;8;516
;;8;546
;;8;548
;;8;573
;;8;594
;;8;672
;;8;673
;;9;581
;;9;596
;;9;603
;;9;614
;;9;621
;;9;622
;;9;626
;;10;538
;;10;539
;;10;541
;;10;552
;;10;757
;;11;506
;;11;515
;;11;550
;;11;553
;;11;583
;;11;610
;;11;655
;;12;535
;;12;537
;;12;556
;;12;578
;;12;585
;;12;607
;;12;676
;;12;695
;;13;437
;;13;438
;;13;568
;;13;579
;;13;618
;;13;656
;;14;555
;;14;574
;;14;584
;;14;592
;;14;597
;;14;636
;;15;452
;;15;543
;;15;589
;;15;609
;;15;647
;;15;657
;;15;677
;;15;686
;;16;502
;;16;520
;;16;564
;;16;580
;;16;586
;;16;598
;;16;623
;;16;629
;;16;635
;;16;667
;;17;522
;;17;549
;;17;591
;;17;671
;;17;674
;;18;501
;;18;504
;;18;519
;;18;644
;;18;649
;;18;678
;;18;756
;;19;436
;;19;442
;;19;554
;;19;567
;;19;575
;;19;617
;;19;660
;;19;666
;;20;463
;;20;531
;;20;648
;;20;653
;;20;663
;;20;668
;;20;687
;;20;692
;;21;358
;;21;459
;;21;570
;;21;612
;;21;640
;;21;654
;;21;662
;;22;593
;;22;600
;;22;601
;;22;605
;;22;664
;;22;665
;;22;691
;;22;752
;;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P43P 2834 printed Sep 23, 2025@19:43:46 Page 2
XU8P43P ;SF-OCIO/CJS - ASSOCIATE STATIONS TO VISNS ;6/27/98 23:20
+1 ;;8.0;KERNEL;**43**;
PRE ; PRE INSTALL FOR XU*8*43
+1 IF $GET(^DD(4,14,0))']"ASSOCIATIONS^4.014P"
Begin DoDot:1
+2 SET DIK="^DD(4,"
SET DA=14
SET DA(1)=4
DO ^DIK
End DoDot:1
+3 IF $GET(^DD(4.014,.01,1,2,0))["^AC"
Begin DoDot:1
+4 SET DIK="^DD(4.014,.01,1,"
SET DA=2
SET DA(1)=.01
SET DA(2)=4
DO ^DIK
KILL ^DIC(4,"AC")
End DoDot:1
+5 QUIT
POST ; POST INSTALL FOR XU*8*43
+1 ; FIRST, SET UP VISNS
+2 NEW FDA,IEN
SET FDA(4.1,"?+1,",.01)="VISN"
SET FDA(4.1,"?+1,",1)="VETERANS INTEGRATED SERVICE NETWORK"
+3 DO UPDATE^DIE("E","FDA","IEN")
+4 NEW VISN,VIS
FOR VISN=1:1:22
SET VIS="VISN "_VISN
IF '$DATA(^DIC(4,"B",VIS))
Begin DoDot:1
+5 SET FDA(4,"+1,",.01)=VIS
SET FDA(4,"+1,",13)="VISN"
+6 DO UPDATE^DIE("E","FDA")
+7 QUIT
End DoDot:1
+8 ; SET UP TMP ARRAY OF ASSOCIATIONS
+9 SET I=0
FOR
SET I=I+1
SET VIS=$PIECE($TEXT(TABLE+I),";",3)
if VIS=""
QUIT
SET VIS($PIECE($TEXT(TABLE+I),";",4))=VIS
+10 ; LOOP THROUGH INSTITUTION FILE SETTING UP ASSOCIATIONS
+11 NEW INST,SN
SET INST=0
FOR
SET INST=$ORDER(^DIC(4,INST))
if INST'>0
QUIT
SET SN=+$GET(^DIC(4,INST,99))
if SN
Begin DoDot:1
+12 if '$DATA(VIS(SN))
QUIT
+13 SET FDA(4,"?1,",.01)="`"_INST
+14 SET FDA(4.014,"+2,?1,",.01)=1
SET FDA(4.014,"+2,?1,",1)="VISN "_VIS(SN)
+15 DO UPDATE^DIE("E","FDA")
+16 QUIT
End DoDot:1
+17 QUIT
TABLE ;;
+1 ;;1;402
+2 ;;1;405
+3 ;;1;518
+4 ;;1;523
+5 ;;1;525
+6 ;;1;608
+7 ;;1;627
+8 ;;1;631
+9 ;;1;650
+10 ;;1;689
+11 ;;2;500
+12 ;;2;514
+13 ;;2;528
+14 ;;2;532
+15 ;;2;670
+16 ;;3;526
+17 ;;3;527
+18 ;;3;533
+19 ;;3;561
+20 ;;3;604
+21 ;;3;620
+22 ;;3;630
+23 ;;3;632
+24 ;;4;460
+25 ;;4;503
+26 ;;4;529
+27 ;;4;540
+28 ;;4;542
+29 ;;4;562
+30 ;;4;595
+31 ;;4;642
+32 ;;4;645
+33 ;;4;646
+34 ;;4;693
+35 ;;5;512
+36 ;;5;566
+37 ;;5;613
+38 ;;5;688
+39 ;;6;517
+40 ;;6;558
+41 ;;6;565
+42 ;;6;590
+43 ;;6;637
+44 ;;6;652
+45 ;;6;658
+46 ;;6;659
+47 ;;7;508
+48 ;;7;509
+49 ;;7;521
+50 ;;7;534
+51 ;;7;544
+52 ;;7;557
+53 ;;7;619
+54 ;;7;679
+55 ;;7;680
+56 ;;7;766
+57 ;;8;516
+58 ;;8;546
+59 ;;8;548
+60 ;;8;573
+61 ;;8;594
+62 ;;8;672
+63 ;;8;673
+64 ;;9;581
+65 ;;9;596
+66 ;;9;603
+67 ;;9;614
+68 ;;9;621
+69 ;;9;622
+70 ;;9;626
+71 ;;10;538
+72 ;;10;539
+73 ;;10;541
+74 ;;10;552
+75 ;;10;757
+76 ;;11;506
+77 ;;11;515
+78 ;;11;550
+79 ;;11;553
+80 ;;11;583
+81 ;;11;610
+82 ;;11;655
+83 ;;12;535
+84 ;;12;537
+85 ;;12;556
+86 ;;12;578
+87 ;;12;585
+88 ;;12;607
+89 ;;12;676
+90 ;;12;695
+91 ;;13;437
+92 ;;13;438
+93 ;;13;568
+94 ;;13;579
+95 ;;13;618
+96 ;;13;656
+97 ;;14;555
+98 ;;14;574
+99 ;;14;584
+100 ;;14;592
+101 ;;14;597
+102 ;;14;636
+103 ;;15;452
+104 ;;15;543
+105 ;;15;589
+106 ;;15;609
+107 ;;15;647
+108 ;;15;657
+109 ;;15;677
+110 ;;15;686
+111 ;;16;502
+112 ;;16;520
+113 ;;16;564
+114 ;;16;580
+115 ;;16;586
+116 ;;16;598
+117 ;;16;623
+118 ;;16;629
+119 ;;16;635
+120 ;;16;667
+121 ;;17;522
+122 ;;17;549
+123 ;;17;591
+124 ;;17;671
+125 ;;17;674
+126 ;;18;501
+127 ;;18;504
+128 ;;18;519
+129 ;;18;644
+130 ;;18;649
+131 ;;18;678
+132 ;;18;756
+133 ;;19;436
+134 ;;19;442
+135 ;;19;554
+136 ;;19;567
+137 ;;19;575
+138 ;;19;617
+139 ;;19;660
+140 ;;19;666
+141 ;;20;463
+142 ;;20;531
+143 ;;20;648
+144 ;;20;653
+145 ;;20;663
+146 ;;20;668
+147 ;;20;687
+148 ;;20;692
+149 ;;21;358
+150 ;;21;459
+151 ;;21;570
+152 ;;21;612
+153 ;;21;640
+154 ;;21;654
+155 ;;21;662
+156 ;;22;593
+157 ;;22;600
+158 ;;22;601
+159 ;;22;605
+160 ;;22;664
+161 ;;22;665
+162 ;;22;691
+163 ;;22;752
+164 ;;;
