- XPDCOMG ;SFISC/RSD - compare globals ;08/14/2008
- ;;8.0;KERNEL;**304,506,559**;Jul 10, 1995;Build 5
- ;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
- ;
- XPDCOMG ;SFISC/RSD - compare globals ;08/14/2008
- +1 ;;8.0;KERNEL;**304,506,559**;Jul 10, 1995;Build 5
- +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 ;
