source: IHS-VA_UTILITIES-XB/XBINIT.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 3.3 KB
Line 
1XBINIT ; IHS/ADC/GTH - XB/ZIB V 3.0 INITS ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 K DIF,DIFQ,DIFQR,DIFQN,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ,DIRUT,DTOUT,DUOUT
5 S DIOVRD=1,U="^",DIFQ=0,DIFROM="3.0" W !,"This version (#3.0) of 'XBINIT' was created on 07-FEB-1997"
6 W !?9,"(at GEORGE'S PC, by VA FileMan V.21.0)",!
7 I $D(^DD("VERSION")),^("VERSION")'<21 G GO
8 ;W !,"FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...." D N^DINIT
9 I ^DD("VERSION")<21 W !,"but I need version 21 of the VA FileMan!" G Q
10GO ;
11 W !,"I HAVE TO RUN AN ENVIRONMENT CHECK ROUTINE." D PKG,^XBPRE Q:'$D(DIFQ) D NOW^%DTC S DIFROM("PRE")=%
12EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM
13 S DIFQ=0 K DIRUT,DTOUT,DUOUT
14 F DIFRIR=1:1:1 S DIFRRTN="^XBINIT"_$E("5",DIFRIR) D @DIFRRTN
15 W:0 !,"I AM GOING TO SET UP THE FOLLOWING FILE:" F I=1:2:0 S DIF(I)=^UTILITY("DIF",$J,I) D 1 G Q:DIFQ!$D(DIRUT) K DIF(I)
16 S DIFROM="3.0" D PKG:'$D(DIFROM(0)),^XBINIT1 G Q:'$D(DIFQ) S DIK(0)="AB"
17 F DIF=1:2:0 S %=^UTILITY("DIF",$J,DIF),DIK=$P(%,";",5),N=$P(%,";",3),D=$P(%,";",4)_U_N D D K DIFQ(N)
18 K DIFQR D ^XBINIT2,^XBINIT3
19 L S DUZ=DIDUZ W:0 !,"NO"_$P("TE THAT FILE",U,DSEC)_" SECURITY-CODE PROTECTION HAS BEEN MADE"
20 D ^XBPOST,NOW^%DTC S DIFROM("INIT")=%
21 I DIFROM F DIF=1:2:0 S %=^UTILITY("DIF",$J,DIF),N=+$P(%,";",3) I N,$P(%,";",8)="y" S ^DD(N,0,"VR")=DIFROM
22 I DIFROM(0)>0 F %="PRE","INI","INIT" S:$D(DIFROM(%)) $P(^DIC(9.4,DIFROM(0),%),U,2)=DIFROM(%)
23 I $G(DIFQN) S $P(^(0),U,3,4)=$P(DIFQN,U,2)_U_($P(^DIC(0),U,4)+DIFQN) K DIFQN
24 I DIFROM,$D(^%ZTSK) S X="XBINIS" X ^%ZOSF("TEST") D:$T PAC^XBINIS($T(IXF),.DIFROM)
25 S:DIFROM(0)>0 ^DIC(9.4,DIFROM(0),"VERSION")=DIFROM G Q^DIFROM0
26D S:$D(^DIC(+N,0))[0 ^(0)=D S X=$D(@(DIK_"0)")),^(0)=D_U_$S(X#2:$P(^(0),U,3,9),1:U)
27 S DIFQR=DIFQR(+N) I ^DD("VERSION")>17.5,$D(^DD(+N,0,"DIK"))#2 S X=^("DIK"),Y=+N,DMAX=^DD("ROU") D EN^DIKZ
28 I DIFQR D IXALL^DIK:$O(@(DIK_"0)")) W "."
29 Q
30R G REP^XBINIT2
31 ;
321 S N=+$P(DIF(I),";",3),DIF=$P(DIF(I),";",4),S=$P(DIF(I),";",5)
33 W !!?3,N,?13,DIF,$P(" (Partial Definition)",U,$P(DIF(I),";",6)),$P(" (including data)",U,$P(DIF(I),";",13)="y") S Z=$S($D(^DIC(N,0))#2:^(0),1:"")
34 I Z="" S DIFQ(N)=1,DIFQN=$G(DIFQN)+1_U_N G S
35 I $L($P(Z,DIF)) W $C(7),!,"*BUT YOU ALREADY HAVE '",$P(Z,U),"' AS FILE #",N,"!" D R Q:DIFQ G S:$D(DIFKEP(N)),1
36 S DIFQ(N)=$P(DIF(I),";",7)'="n"
37 I $L(Z) W $C(7),!,"Note: You already have the '",$P(Z,U),"' File." S DIFQ(0)=1
38 S %=$E(^UTILITY("DIF",$J,I+1),4,245) I %]"" X % S DIFQ(N)=$T W:'$T !,"Screen on this Data Dictionary did not pass--DD will not be installed!" G S
39 I $L(Z),$P(DIF(I),";",10)="y" S DIR("A")="Shall I write over the existing Data Definition",DIR("??")="^D DD^DIFROMH1",DIR("B")="YES",DIR(0)="Y" D ^DIR S DIFQ(N)=Y
40S S DIFQR(N)=0 Q:$P(DIF(I),";",13)'="y"!$D(DIRUT)
41 I $P(DIF(I),";",15)="y",$O(@(S_"0)"))>0 S DIF=$P(DIF(I),";",14)="o",DIR("A")="Want my data "_$P("merged with^to overwrite",U,DIF+1)_" yours",DIR("??")="^D DTA^DIFROMH1",DIR(0)="Y" D ^DIR S DIFQR(N)=$S('Y:Y,1:Y+DIF) Q
42 S %=$P(DIF(I),";",14)="o" W !,$C(7),"I will ",$P("MERGE^OVERWRITE",U,%+1)," your data with mine." S DIFQR(N)=%+1
43 Q
44Q W $C(7),!!,"NO UPDATING HAS OCCURRED!" G Q^DIFROM0
45 ;
46PKG S X=$P($T(IXF),";",3),DIC="^DIC(9.4,",DIC(0)="",DIC("S")="I $P(^(0),U,2)="""_$P(X,U,2)_"""",X=$P(X,U) D ^DIC S DIFROM(0)=+Y K DIC
47 Q
48 ;
49IXF ;;IHS/VA UTILITIES^XB;0
Note: See TracBrowser for help on using the repository browser.