XPDCOMG ;SFISC/RSD - compare globals ;08/14/2008
;;8.0;KERNEL;**304,506,559**;Jul 10, 1995;Build 4
;Per VHA Directive 2004-038, this routine should not be modified.
EN D IX,FIA:'$D(DIRUT),KRN:'$D(DIRUT)
Q
;
IX ;FileMan new style cross-references
N XPDF,XPDF2,XPDFN
F XPDF=0:0 S XPDF=$O(^XTMP("XPDI",XPDA,"IX",XPDF)) Q:'XPDF F XPDF2=0:0 S XPDF2=$O(^XTMP("XPDI",XPDA,"IX",XPDF,XPDF2)) Q:'XPDF2 D
.S XPDFN="" F S XPDFN=$O(^XTMP("XPDI",XPDA,"IX",XPDF,XPDF2,XPDFN)) Q:XPDFN=""!$D(DIRUT) D
..K ^TMP($J) M ^TMP($J,1)=^XTMP("XPDI",XPDA,"IX",XPDF,XPDF2,XPDFN)
..D DASHES,EN^XPDCOMF($NA(^TMP($J)),$NA(^DD("IX")),.11,"1L",.DITCPT)
..Q
Q
;
FIA ;FileMan DD and Data
N DIC,OLDA,XPDFIL,XPDFILO,XPDFILS,XPDS,XPDS0,XPDX,XPDX0,XPDY,XPDY1,XPDZ,XPDZ1,X,Y
S XPDFIL=0
F S XPDFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPDFIL)) Q:'XPDFIL!$D(DIRUT) S X=^(XPDFIL),XPDZ1=^(XPDFIL,0),XPDFILO=^(0,1) D
.I '$D(^DIC(XPDFIL)) W !!,?14," FILE # ",XPDFIL," (",X,") is NEW",! Q
.S XPDZ="^XTMP(""XPDI"","_XPDA,XPDY=XPDZ_",""^DIC"","_XPDFIL_","_XPDFIL_",0",XPDX=XPDY_")"
.S XPDY=XPDY_",",XPDY1="^DIC("_XPDFIL_",0",XPDS=XPDY1_")",XPDY1=XPDY1_","
.I $P(XPDFILO,U)="y" D
..;W !!,XPDUL," File # ",XPDFIL," Data Dictionary "
..S XPDFILS=0 F S XPDFILS=$O(^XTMP("XPDI",XPDA,"^DD",XPDFIL,XPDFILS)) Q:'XPDFILS D
...S XPDY=XPDZ_",""^DD"","_XPDFIL_","_XPDFILS,XPDX=XPDY_")",XPDY=XPDY_",",XPDY1="^DD("_XPDFILS,XPDS=XPDY1_")",XPDY1=XPDY1_","
...D DASHES,EN^XPDCOMF(XPDX,XPDS,0,"1L",.DITCPT)
...Q
..Q
.;check Data in file
.Q:'$D(^XTMP("XPDI",XPDA,"DATA",XPDFIL))
.D DASHES,EN^XPDCOMF($NA(^(XPDFIL)),$$CREF^DIQGU(^DIC(XPDFIL,0,"GL")),XPDFIL,"1L",.DITCPT)
W ! Q
;
KRN ;Kernel Components
N DEL,DIC,OLDA,ORD,X,XPDFIL,XPDFILNM,XPDI,XPDS,XPDS0,XPDX,XPDX0,XPDY,XPDY1,XPDZ,XPDZ1,Y
S ORD=0
F S ORD=$O(^XTMP("XPDI",XPDA,"ORD",ORD)) Q:'ORD!$D(DIRUT) S XPDFIL=+$O(^(ORD,0)),XPDFILNM=$G(^(XPDFIL,0)) D:XPDFIL
.I $P($G(^DIC(XPDFIL,0)),U)'=XPDFILNM W !!," File "_XPDFIL_" is not "_XPDFILNM_", nothing can be installed.",! Q
.D DASHES,EN^XPDCOMF($NA(^XTMP("XPDI",XPDA,"KRN",XPDFIL)),$$CREF^DIQGU(^DIC(XPDFIL,0,"GL")),XPDFIL,"1L",.DITCPT)
.Q
Q
;
DASHES K DITCPT S DITCPT(0)=XPDUL
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDCOMG 2201 printed Nov 22, 2024@17:13:25 Page 2
XPDCOMG ;SFISC/RSD - compare globals ;08/14/2008
+1 ;;8.0;KERNEL;**304,506,559**;Jul 10, 1995;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
EN DO IX
if '$DATA(DIRUT)
DO FIA
if '$DATA(DIRUT)
DO KRN
+1 QUIT
+2 ;
IX ;FileMan new style cross-references
+1 NEW XPDF,XPDF2,XPDFN
+2 FOR XPDF=0:0
SET XPDF=$ORDER(^XTMP("XPDI",XPDA,"IX",XPDF))
if 'XPDF
QUIT
FOR XPDF2=0:0
SET XPDF2=$ORDER(^XTMP("XPDI",XPDA,"IX",XPDF,XPDF2))
if 'XPDF2
QUIT
Begin DoDot:1
+3 SET XPDFN=""
FOR
SET XPDFN=$ORDER(^XTMP("XPDI",XPDA,"IX",XPDF,XPDF2,XPDFN))
if XPDFN=""!$DATA(DIRUT)
QUIT
Begin DoDot:2
+4 KILL ^TMP($JOB)
MERGE ^TMP($JOB,1)=^XTMP("XPDI",XPDA,"IX",XPDF,XPDF2,XPDFN)
+5 DO DASHES
DO EN^XPDCOMF($NAME(^TMP($JOB)),$NAME(^DD("IX")),.11,"1L",.DITCPT)
+6 QUIT
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
FIA ;FileMan DD and Data
+1 NEW DIC,OLDA,XPDFIL,XPDFILO,XPDFILS,XPDS,XPDS0,XPDX,XPDX0,XPDY,XPDY1,XPDZ,XPDZ1,X,Y
+2 SET XPDFIL=0
+3 FOR
SET XPDFIL=$ORDER(^XTMP("XPDI",XPDA,"FIA",XPDFIL))
if 'XPDFIL!$DATA(DIRUT)
QUIT
SET X=^(XPDFIL)
SET XPDZ1=^(XPDFIL,0)
SET XPDFILO=^(0,1)
Begin DoDot:1
+4 IF '$DATA(^DIC(XPDFIL))
WRITE !!,?14," FILE # ",XPDFIL," (",X,") is NEW",!
QUIT
+5 SET XPDZ="^XTMP(""XPDI"","_XPDA
SET XPDY=XPDZ_",""^DIC"","_XPDFIL_","_XPDFIL_",0"
SET XPDX=XPDY_")"
+6 SET XPDY=XPDY_","
SET XPDY1="^DIC("_XPDFIL_",0"
SET XPDS=XPDY1_")"
SET XPDY1=XPDY1_","
+7 IF $PIECE(XPDFILO,U)="y"
Begin DoDot:2
+8 ;W !!,XPDUL," File # ",XPDFIL," Data Dictionary "
+9 SET XPDFILS=0
FOR
SET XPDFILS=$ORDER(^XTMP("XPDI",XPDA,"^DD",XPDFIL,XPDFILS))
if 'XPDFILS
QUIT
Begin DoDot:3
+10 SET XPDY=XPDZ_",""^DD"","_XPDFIL_","_XPDFILS
SET XPDX=XPDY_")"
SET XPDY=XPDY_","
SET XPDY1="^DD("_XPDFILS
SET XPDS=XPDY1_")"
SET XPDY1=XPDY1_","
+11 DO DASHES
DO EN^XPDCOMF(XPDX,XPDS,0,"1L",.DITCPT)
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 ;check Data in file
+15 if '$DATA(^XTMP("XPDI",XPDA,"DATA",XPDFIL))
QUIT
+16 DO DASHES
DO EN^XPDCOMF($NAME(^(XPDFIL)),$$CREF^DIQGU(^DIC(XPDFIL,0,"GL")),XPDFIL,"1L",.DITCPT)
End DoDot:1
+17 WRITE !
QUIT
+18 ;
KRN ;Kernel Components
+1 NEW DEL,DIC,OLDA,ORD,X,XPDFIL,XPDFILNM,XPDI,XPDS,XPDS0,XPDX,XPDX0,XPDY,XPDY1,XPDZ,XPDZ1,Y
+2 SET ORD=0
+3 FOR
SET ORD=$ORDER(^XTMP("XPDI",XPDA,"ORD",ORD))
if 'ORD!$DATA(DIRUT)
QUIT
SET XPDFIL=+$ORDER(^(ORD,0))
SET XPDFILNM=$GET(^(XPDFIL,0))
if XPDFIL
Begin DoDot:1
+4 IF $PIECE($GET(^DIC(XPDFIL,0)),U)'=XPDFILNM
WRITE !!," File "_XPDFIL_" is not "_XPDFILNM_", nothing can be installed.",!
QUIT
+5 DO DASHES
DO EN^XPDCOMF($NAME(^XTMP("XPDI",XPDA,"KRN",XPDFIL)),$$CREF^DIQGU(^DIC(XPDFIL,0,"GL")),XPDFIL,"1L",.DITCPT)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
DASHES KILL DITCPT
SET DITCPT(0)=XPDUL
+1 QUIT
+2 ;
