IBDEINIT ; ; 01-AUG-2022
;;3.0;IB ENCOUNTER FORM IMP/EXP;;AUG 01, 2022
;
K DIF,DIFQ,DIFQR,DIFQN,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ,DIRUT,DTOUT,DUOUT
S DIOVRD=1,U="^",DIFQ=0,DIFROM="3.0" W !,"This version (#3.0) of 'IBDEINIT' was created on 01-AUG-2022"
W !?9,"(at ORLANDO.DOMAIN.EXT, by VA FileMan 22.2)",!
I $D(^DD("VERSION")),^("VERSION")'<22.2 G GO
;W !,"FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...." D N^DINIT
I ^DD("VERSION")<22.2 W !,"but I need version 22.2 of the VA FileMan!" G Q
GO ;
W !,"I HAVE TO RUN AN ENVIRONMENT CHECK ROUTINE." D PKG,^IBDEPRE Q:'$D(DIFQ) D NOW^%DTC S DIFROM("PRE")=%
EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM
S DIFQ=0 K DIRUT,DTOUT,DUOUT
F DIFRIR=1:1:1 S DIFRRTN="^IBDEINI"_$E("5",DIFRIR) D @DIFRRTN
W:1 !,"I AM GOING TO SET UP THE FOLLOWING FILES:" F I=1:2:28 S DIF(I)=^UTILITY("DIF",$J,I) D 1 G Q:DIFQ!$D(DIRUT) K DIF(I)
S DIFROM="3.0" D PKG:'$D(DIFROM(0)),^IBDEINI1 G Q:'$D(DIFQ) S DIK(0)="AB"
F DIF=1:2:28 S %=^UTILITY("DIF",$J,DIF),DIK=$P(%,";",5),N=$P(%,";",3),D=$P(%,";",4)_U_N D D K DIFQ(N)
K DIFQR D ^IBDEINI2,^IBDEINI3
L S DUZ=DIDUZ W:1 !,"NO"_$P("TE THAT FILE",U,DSEC)_" SECURITY-CODE PROTECTION HAS BEEN MADE"
D ^IBDEPT,NOW^%DTC S DIFROM("INIT")=%
I DIFROM F DIF=1:2:28 S %=^UTILITY("DIF",$J,DIF),N=+$P(%,";",3) I N,$P(%,";",8)="y" S ^DD(N,0,"VR")=DIFROM
I DIFROM(0)>0 F %="PRE","INI","INIT" S:$D(DIFROM(%)) $P(^DIC(9.4,DIFROM(0),%),U,2)=DIFROM(%)
I $G(DIFQN) S $P(^(0),U,3,4)=$P(DIFQN,U,2)_U_($P(^DIC(0),U,4)+DIFQN) K DIFQN
I DIFROM,$D(^%ZTSK) S X="IBDEINIS" X ^%ZOSF("TEST") D:$T PAC^IBDEINIS($T(IXF),.DIFROM)
S:DIFROM(0)>0 ^DIC(9.4,DIFROM(0),"VERSION")=DIFROM G Q^DIFROM0
D 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)
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
I DIFQR D IXALL^DIK:$O(@(DIK_"0)")) W "."
Q
R G REP^IBDEINI2
;
1 S N=+$P(DIF(I),";",3),DIF=$P(DIF(I),";",4),S=$P(DIF(I),";",5)
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:"")
I Z="" S DIFQ(N)=1,DIFQN=$G(DIFQN)+1_U_N G S
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
S DIFQ(N)=$P(DIF(I),";",7)'="n"
I $L(Z) W $C(7),!,"Note: You already have the '",$P(Z,U),"' File." S DIFQ(0)=1
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
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
S S DIFQR(N)=0 Q:$P(DIF(I),";",13)'="y"!$D(DIRUT)
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
S %=$P(DIF(I),";",14)="o" W !,$C(7),"I will ",$P("MERGE^OVERWRITE",U,%+1)," your data with mine." S DIFQR(N)=%+1
Q
Q W $C(7),!!,"NO UPDATING HAS OCCURRED!" G Q^DIFROM0
;
PKG 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
Q
;
IXF ;;IB ENCOUNTER FORM IMP/EXP^IBDE;303035
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEINIT 3405 printed Sep 23, 2025@20:26:36 Page 2
IBDEINIT ; ; 01-AUG-2022
+1 ;;3.0;IB ENCOUNTER FORM IMP/EXP;;AUG 01, 2022
+2 ;
+3 KILL DIF,DIFQ,DIFQR,DIFQN,DIK,DDF,DDT,DTO,D0,DLAYGO,DIC,DIDUZ,DIR,DA,DIFROM,DFR,DTN,DIX,DZ,DIRUT,DTOUT,DUOUT
+4 SET DIOVRD=1
SET U="^"
SET DIFQ=0
SET DIFROM="3.0"
WRITE !,"This version (#3.0) of 'IBDEINIT' was created on 01-AUG-2022"
+5 WRITE !?9,"(at ORLANDO.DOMAIN.EXT, by VA FileMan 22.2)",!
+6 IF $DATA(^DD("VERSION"))
IF ^("VERSION")'<22.2
GOTO GO
+7 ;W !,"FIRST, I'LL FRESHEN UP YOUR VA FILEMAN...." D N^DINIT
+8 IF ^DD("VERSION")<22.2
WRITE !,"but I need version 22.2 of the VA FileMan!"
GOTO Q
GO ;
+1 WRITE !,"I HAVE TO RUN AN ENVIRONMENT CHECK ROUTINE."
DO PKG
DO ^IBDEPRE
if '$DATA(DIFQ)
QUIT
DO NOW^%DTC
SET DIFROM("PRE")=%
EN ; ENTER HERE TO BYPASS THE PRE-INIT PROGRAM
+1 SET DIFQ=0
KILL DIRUT,DTOUT,DUOUT
+2 FOR DIFRIR=1:1:1
SET DIFRRTN="^IBDEINI"_$EXTRACT("5",DIFRIR)
DO @DIFRRTN
+3 if 1
WRITE !,"I AM GOING TO SET UP THE FOLLOWING FILES:"
FOR I=1:2:28
SET DIF(I)=^UTILITY("DIF",$JOB,I)
DO 1
if DIFQ!$DATA(DIRUT)
GOTO Q
KILL DIF(I)
+4 SET DIFROM="3.0"
if '$DATA(DIFROM(0))
DO PKG
DO ^IBDEINI1
if '$DATA(DIFQ)
GOTO Q
SET DIK(0)="AB"
+5 FOR DIF=1:2:28
SET %=^UTILITY("DIF",$JOB,DIF)
SET DIK=$PIECE(%,";",5)
SET N=$PIECE(%,";",3)
SET D=$PIECE(%,";",4)_U_N
DO D
KILL DIFQ(N)
+6 KILL DIFQR
DO ^IBDEINI2
DO ^IBDEINI3
+7 LOCK
SET DUZ=DIDUZ
if 1
WRITE !,"NO"_$PIECE("TE THAT FILE",U,DSEC)_" SECURITY-CODE PROTECTION HAS BEEN MADE"
+8 DO ^IBDEPT
DO NOW^%DTC
SET DIFROM("INIT")=%
+9 IF DIFROM
FOR DIF=1:2:28
SET %=^UTILITY("DIF",$JOB,DIF)
SET N=+$PIECE(%,";",3)
IF N
IF $PIECE(%,";",8)="y"
SET ^DD(N,0,"VR")=DIFROM
+10 IF DIFROM(0)>0
FOR %="PRE","INI","INIT"
if $DATA(DIFROM(%))
SET $PIECE(^DIC(9.4,DIFROM(0),%),U,2)=DIFROM(%)
+11 IF $GET(DIFQN)
SET $PIECE(^(0),U,3,4)=$PIECE(DIFQN,U,2)_U_($PIECE(^DIC(0),U,4)+DIFQN)
KILL DIFQN
+12 IF DIFROM
IF $DATA(^%ZTSK)
SET X="IBDEINIS"
XECUTE ^%ZOSF("TEST")
if $TEST
DO PAC^IBDEINIS($TEXT(IXF),.DIFROM)
+13 if DIFROM(0)>0
SET ^DIC(9.4,DIFROM(0),"VERSION")=DIFROM
GOTO Q^DIFROM0
D if $DATA(^DIC(+N,0))[0
SET ^(0)=D
SET X=$DATA(@(DIK_"0)"))
SET ^(0)=D_U_$SELECT(X#2:$PIECE(^(0),U,3,9),1:U)
+1 SET DIFQR=DIFQR(+N)
IF ^DD("VERSION")>17.5
IF $DATA(^DD(+N,0,"DIK"))#2
SET X=^("DIK")
SET Y=+N
SET DMAX=^DD("ROU")
DO EN^DIKZ
+2 IF DIFQR
if $ORDER(@(DIK_"0)"))
DO IXALL^DIK
WRITE "."
+3 QUIT
R GOTO REP^IBDEINI2
+1 ;
1 SET N=+$PIECE(DIF(I),";",3)
SET DIF=$PIECE(DIF(I),";",4)
SET S=$PIECE(DIF(I),";",5)
+1 WRITE !!?3,N,?13,DIF,$PIECE(" (Partial Definition)",U,$PIECE(DIF(I),";",6)),$PIECE(" (including data)",U,$PIECE(DIF(I),";",13)="y")
SET Z=$SELECT($DATA(^DIC(N,0))#2:^(0),1:"")
+2 IF Z=""
SET DIFQ(N)=1
SET DIFQN=$GET(DIFQN)+1_U_N
GOTO S
+3 IF $LENGTH($PIECE(Z,DIF))
WRITE $CHAR(7),!,"*BUT YOU ALREADY HAVE '",$PIECE(Z,U),"' AS FILE #",N,"!"
DO R
if DIFQ
QUIT
if $DATA(DIFKEP(N))
GOTO S
GOTO 1
+4 SET DIFQ(N)=$PIECE(DIF(I),";",7)'="n"
+5 IF $LENGTH(Z)
WRITE $CHAR(7),!,"Note: You already have the '",$PIECE(Z,U),"' File."
SET DIFQ(0)=1
+6 SET %=$EXTRACT(^UTILITY("DIF",$JOB,I+1),4,245)
IF %]""
XECUTE %
SET DIFQ(N)=$TEST
if '$TEST
WRITE !,"Screen on this Data Dictionary did not pass--DD will not be installed!"
GOTO S
+7 IF $LENGTH(Z)
IF $PIECE(DIF(I),";",10)="y"
SET DIR("A")="Shall I write over the existing Data Definition"
SET DIR("??")="^D DD^DIFROMH1"
SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
SET DIFQ(N)=Y
S SET DIFQR(N)=0
if $PIECE(DIF(I),";",13)'="y"!$DATA(DIRUT)
QUIT
+1 IF $PIECE(DIF(I),";",15)="y"
IF $ORDER(@(S_"0)"))>0
SET DIF=$PIECE(DIF(I),";",14)="o"
SET DIR("A")="Want my data "_$PIECE("merged with^to overwrite",U,DIF+1)_" yours"
SET DIR("??")="^D DTA^DIFROMH1"
SET DIR(0)="Y"
DO ^DIR
SET DIFQR(N)=$SELECT('Y:Y,1:Y+DIF)
QUIT
+2 SET %=$PIECE(DIF(I),";",14)="o"
WRITE !,$CHAR(7),"I will ",$PIECE("MERGE^OVERWRITE",U,%+1)," your data with mine."
SET DIFQR(N)=%+1
+3 QUIT
Q WRITE $CHAR(7),!!,"NO UPDATING HAS OCCURRED!"
GOTO Q^DIFROM0
+1 ;
PKG SET X=$PIECE($TEXT(IXF),";",3)
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET DIC("S")="I $P(^(0),U,2)="""_$PIECE(X,U,2)_""""
SET X=$PIECE(X,U)
DO ^DIC
SET DIFROM(0)=+Y
KILL DIC
+1 QUIT
+2 ;
IXF ;;IB ENCOUNTER FORM IMP/EXP^IBDE;303035
