Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIFROMS2

DIFROMS2.m

Go to the documentation of this file. 
  1. DIFROMS2 ;SFISC/DCL/TKW-INSTALL DD FROM SOURCE ARRAY ;9:06 AM  14 Jul 2000 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**11,53**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  Q
  1. EN ;
  1.  I '$D(@DIFRSA) D ERR(5) Q
  1.  I '$D(@DIFRFIA) D ERR(4) Q
  1.  G:$G(DIFRFILE) FCHK
  1.  S DIFRFILE=0 F  S DIFRFILE=$O(@DIFRFIA@(DIFRFILE)) Q:DIFRFILE'>0  D FILE
  1.  Q
  1. FCHK I '$D(@DIFRFIA@(DIFRFILE)) D ERR(6) Q
  1. FILE ;
  1.  N DIFR01,DIFR02,DIFRVR,DIFRFDD
  1.  S DIFR01=$G(@DIFRFIA@(DIFRFILE,0,1)),DIFR02=$G(^(2))
  1.  I $TR($E(DIFR01),"NY","ny")="n" D ERR(1) Q
  1.  S DIFRFDD=$TR($P(DIFR01,"^",3),"FP","fp")'="p"
  1.  I 'DIFRFDD,'$D(^DIC(DIFRFILE)) D ERR(7) Q
  1.  I $D(^DIC(DIFRFILE,0)),$G(@DIFRFIA@(DIFRFILE,0,10))]"" X ^(10) I '$T D ERR(3) Q
  1.  ;I $TR($E(@DIFRFIA@(DIFRFILE,0,5)),"NY","ny")="y",$D(^DIC(DIFRFILE)) D ERR(2) Q  ;INSTALL ONLY IF NEW * * PHASING OUT * *
  1.  N %1,DSEC,D,DA,DIC,DIK,DIFRD,DIFRDATA,DIFRFLD,DIFRDIC,DIFRGL,DIFRX,I,X,Y,Z
  1.  S DSEC=$P(DIFR02,"^") ; **>> add file security if new file only <<**
  1.  I 'DSEC,'$D(^DIC(DIFRFILE,0))#2 S DSEC=1 ; Check to see if the file was Deleted during Pre-Install
  1.  ;delete DD wp text for file, field and x-ref description and field tech description
  1.  ;also delete "NM" nodes when installing full DD at specified level
  1.  I 'DIFRFDD D
  1.  .K @DIFRSA@("DIFRNI",DIFRFILE)
  1.  .N DIFRD
  1.  .S DIFRD=DIFRFILE
  1.  .F  S DIFRD=$O(@DIFRFIA@(DIFRFILE,DIFRD)) Q:DIFRD'>0  D
  1.  ..Q:$$UP(DIFRSA,DIFRFILE,DIFRD)
  1.  ..S @DIFRSA@("DIFRNI",DIFRFILE,DIFRD)=""
  1.  ..N DIFRNGF,DIFRNGFD
  1.  ..S DIFRNGF=+$G(@DIFRSA@("UP",DIFRFILE,DIFRD,-1))
  1.  ..S DIFRNGFD=.01 F  S DIFRNGFD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRNGF,DIFRNGFD)) Q:DIFRNGFD=""  Q:+$P($G(^(DIFRNGFD,0)),U,2)=DIFRD
  1.  ..I DIFRNGFD'="" K @DIFRSA@("^DD",DIFRFILE,DIFRNGF,DIFRNGFD)
  1.  ..Q
  1.  .Q
  1.  K:DIFRFDD ^DIC(DIFRFILE,"%D")
  1.  S DIFRD=0
  1.  F  S DIFRD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD)) Q:DIFRD'>0  D
  1.  .I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
  1.  .K:$D(@DIFRSA@("^DD",DIFRFILE,DIFRD,0,"NM"))\10 ^DD(DIFRD,0,"NM")
  1.  .S DIFRFLD=0
  1.  .F  S DIFRFLD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRFLD)) Q:DIFRFLD'>0  D
  1.  ..K ^DD(DIFRD,DIFRFLD,21),^(23)
  1.  ..S DIFRX=0
  1.  ..F  S DIFRX=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD,DIFRFLD,1,DIFRX)) Q:DIFRX'>0  D
  1.  ...K ^DD(DIFRD,DIFRFLD,1,DIFRX,"%D")
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I DIFRFDD F DIFRX="^DIC","^DD" D
  1.  .;I DIFRX="^DIC",'DIFRFDD Q
  1.  .N X
  1.  .I DIFRX="^DIC",$G(^DIC(DIFRFILE,0))]"" S X=$P(^(0),"^",3,9)
  1.  .M @DIFRX=@DIFRSA@(DIFRX,DIFRFILE)
  1.  .I DIFRX="^DIC",$G(X)]"" S $P(^DIC(DIFRFILE,0),"^",3,9)=X
  1.  .I DSEC,$D(@DIFRSA@("SEC",DIFRX,DIFRFILE)) M @DIFRX=@DIFRSA@("SEC",DIFRX,DIFRFILE)
  1.  .Q
  1.  I 'DIFRFDD D
  1.  .N DIFRD
  1.  .S DIFRD=0
  1.  .F  S DIFRD=$O(@DIFRSA@("^DD",DIFRFILE,DIFRD)) Q:DIFRD'>0  D
  1.  ..I $D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
  1.  ..M ^DD(DIFRD)=@DIFRSA@("^DD",DIFRFILE,DIFRD)
  1.  ..I DSEC,$D(@DIFRSA@("SEC","^DD",DIFRFILE,DIFRD)) M ^DD(DIFRD)=@DIFRSA@("SEC","^DD",DIFRFILE,DIFRD)
  1.  ..Q
  1.  .Q
  1.  S DIFRD=0 F  S DIFRD=$O(@DIFRFIA@(DIFRFILE,DIFRD)) Q:DIFRD'>0  D
  1.  .I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q
  1.  .S D=DIFRD,DIK="A" F  S DIK=$O(^DD(D,DIK)) Q:DIK=""  K ^(DIK)
  1.  .S DA(1)=D,DIK="^DD("_D_"," D IXALL^DIK
  1.  .I $D(^DIC(D,"%",0)) S DIK="^DIC(D,""%""," D IXALL^DIK
  1.  .Q
  1.  I 'DIFRFDD D  G IXKEY
  1.  .Q:'$D(@DIFRSA@("^DD",DIFRFILE,DIFRFILE,.01))
  1.  .S $P(@(^DIC(DIFRFILE,0,"GL")_"0)"),"^",2)=$$HDR2P^DIFROMSS(DIFRFILE)
  1.  .Q
  1.  S DIFRGL=^DIC(DIFRFILE,0,"GL"),DIFRDIC=$P(^DIC(DIFRFILE,0),U,1,2)
  1.  S $P(DIFRDIC,"^",2)=@DIFRFIA@(DIFRFILE,0,0)
  1.  I DIFRFDD,+$G(@DIFRFIA@(DIFRFILE,0,"VR")) S DIFRVR=^("VR") D
  1.  .S ^DD(DIFRFILE,0,"VR")=$P(DIFRVR,"^")
  1.  .S ^DD(DIFRFILE,0,"VRPK")=$P(DIFRVR,"^",2)
  1.  .Q
  1.  S DIFRDATA=$D(@(DIFRGL_"0)")),^(0)=DIFRDIC_"^"_$S(DIFRDATA#2:$P(^(0),"^",3,9),1:"^")
  1.  ;
  1. IXKEY ; Bring INDEX and KEY entries
  1.  K ^TMP("DIFROMS2",$J,"TRIG")
  1.  S DIFRD=0
  1.  F  S DIFRD=$O(@DIFRSA@("IX",DIFRFILE,DIFRD)) Q:'DIFRD  D DDIXIN^DIFROMSX(DIFRFILE,DIFRD,DIFRSA)
  1.  K ^TMP("DIFROMS2",$J,"TRIG")
  1.  S DIFRD=0
  1.  F  S DIFRD=$O(@DIFRSA@("KEY",DIFRFILE,DIFRD)) Q:'DIFRD  D DDKEYIN^DIFROMSY(DIFRFILE,DIFRD,DIFRSA)
  1.  ;
  1. DIKZ I $D(^DD(DIFRFILE,0,"DIK")) D
  1.  .N %X,DIKJ,DIR,DMAX,X,Y,DIFRDIKA
  1.  .D EN2^DIKZ(DIFRFILE,"",^DD(DIFRFILE,0,"DIK"),^DD("ROU"),"DIFRDIKA")
  1.  .I $D(DIFRDIKA) M @DIFRSA@("DIKZ",DIFRFILE)=DIFRDIKA
  1.  .S @DIFRSA@("DIKZ",DIFRFILE)=^DD(DIFRFILE,0,"DIK")
  1.  .Q
  1.  I 'DIFRFDD,$D(@DIFRSA@("DIFRNI",DIFRFILE)) D
  1.  .N DIFRD
  1.  .S DIFRD=0
  1.  .F  S DIFRD=$O(@DIFRSA@("DIFRNI",DIFRFILE,DIFRD)) Q:DIFRD'>0  D
  1.  ..N DIFRERR S DIFRERR(1)=DIFRD
  1.  ..D BLD^DIALOG(9512,.DIFRERR)
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. UP(ROOT,FILE,DDN) ;Return 1 or 0 to install
  1.  Q:FILE=DDN 1
  1.  Q:$D(^DD(DDN)) 1
  1.  Q:'$D(@ROOT@("UP",FILE,DDN)) 1
  1.  N MP,PARENT,T,X
  1.  S MP=0,X="",T=0
  1.  F  S X=$O(@ROOT@("UP",FILE,DDN,X)) Q:X=""  S PARENT=+^(X) D  Q:T!(MP)
  1.  .I $D(^DD(PARENT))!($G(@ROOT@("FIA",FILE,PARENT))=0) S:X=0 T=1 Q
  1.  .S MP=1
  1.  .Q
  1.  Q T
  1.  ;
  1. ERR(X) D BLD^DIALOG($P($T(ERR+X),";",5)) Q
  1.  ;;FIA Node Is Set To "No DD Update";1;9503
  1.  ;;Already Exist On Target System (INSTALL ONLY IF NEW);2;9504
  1.  ;;Did Not Pass DD Screen;3;9505
  1.  ;;FIA Array Does Not Exist;4;9511
  1.  ;;Distribution Array Does Not Exist;5;9506
  1.  ;;FIA File Number Invalid;6;9507
  1.  ;;Partial DD/File Does Not Already Exist On Target System;7;9508