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

DIFROMS5.m

Go to the documentation of this file. 
  1. DIFROMS5 ;SCISC/DCL-DIFROM SERVER PROCESS TEMPLATES OUT ;1:40 PM  4 Sep 1998
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  Q
  1.  ;
  1. EDEOUT ;EXTENDED DATABASE ELEMENTS OUT
  1.  N DIFRDSV,DIFRF,DIFRGBL,DIFRSEC,DIFRTRT
  1.  I $G(DIFRIEN)>0 G EDE
  1.  N DIFRIENX,DIFRIENZ
  1.  S DIFRIENX=$O(@DIFRLST@(0)),DIFRIENZ=$D(@DIFRLST@(DIFRIENX,0))#2,DIFRIENX=0
  1.  F  S DIFRIENX=$O(@DIFRLST@(DIFRIENX)) Q:DIFRIENX'>0  D
  1.  .I DIFRIENZ S DIFRIEN=+@DIFRLST@(DIFRIENX,0) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
  1.  .S DIFRIEN=+@DIFRLST@(DIFRIENX) S:DIFRIEN'>0 DIFRIEN=DIFRIENX D EDE Q
  1.  Q
  1. EDE ;
  1.  ;  DIFRTRT=FULL ROOT IN DIST ARRAY
  1.  ;  DIFRDSV=0TH NODE OF TEMPLATE
  1.  ;         :.401, .4, .402
  1.  ;         :TEMPL NAME^DATE CREATED^READ^FILENR^DUZ^WRITE^DATE LAST USED
  1.  ;         :.403
  1.  ;         :FORM NAME^READ^WRITE^DUZ^DATE CREATED^DATA LAST USED^^FILE^
  1.  ;         :.84
  1.  ;         :DIALOG NUMBER^TYPE^INTERNAL PARM^PACKAGE FILE (pointer)
  1.  ;  DIFRSEC=FILE SECURITY 1=EXPORT SECURITY,0=NO FILE SECURITY
  1.  ;  DIFRIEN=TEMPLATE'S INTERNAL ENTRY NUMBER
  1.  ;         :.5 (FUNCTIONS)
  1.  S DIFRTRT=$NA(@DIFRTA@(DIFRFILE,DIFRIEN))
  1.  S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1)
  1.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1.  ;
  1.  ; For stand alone FileMan only - KIDS will do the Merge
  1.  ; v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
  1.  ;
  1.  I $G(DIFRSTNA) S DIFRGBL=$$ROOT^DILFD(DIFRFILE,"",1) M @DIFRTRT=@DIFRGBL@(DIFRIEN)
  1.  ;
  1.  ; ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
  1.  ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1.  I DIFRFILE=.5 Q  ;no processing necessary
  1.  S DIFRDSV=$G(@DIFRTRT@(0)),DIFRF=$P(DIFRDSV,U,$S(DIFRFILE=.403:8,1:4))
  1.  I DIFRDSV="" D  Q
  1.  .N DIFRERR S DIFRERR(1)=DIFRFNAM,DIFRERR(2)=DIFRIEN
  1.  .D BLD^DIALOG(9516,.DIFRERR)
  1.  .Q
  1.  I DIFRFILE=.84 G DIALOG
  1.  S DIFRSEC=DIFRFLG'["S"
  1.  I DIFRFILE=.403 G T403
  1.  Q:'$D(@DIFRTRT@(0))  K ^("RD"),^("AB") K:DIFRFILE=.401 ^(1)
  1.  S $P(@DIFRTRT@(0),U,5)="" S:'DIFRSEC ^(0)=$P(DIFRDSV,U,1,2)_U_U_DIFRF_U_U_U_U_$P(DIFRDSV,U,8,9)
  1.  Q
  1.  ;
  1. T403 ;PROCESS FORMS AND EACH BLOCK IT CONTAINES
  1.  S $P(DIFRDSV,U,4)="",$P(DIFRDSV,U,6)="" S:'DIFRSEC $P(DIFRDSV,U,2,3)=U
  1.  S @DIFRTRT@(0)=DIFRDSV
  1.  D T404
  1.  K @DIFRTRT@("AY"),@DIFRTRT@(40,"B"),^("C")
  1.  N X
  1.  S X=0
  1.  F  S X=$O(@DIFRTRT@(40,X)) Q:X'>0  K @DIFRTRT@(40,X,40,"AC"),^("B")
  1.  Q
  1.  ;
  1. T404 ;PROCESS BLOCKS
  1.  ;    :.404
  1.  ;    :BLOCK NAME^
  1.  N DIFR1,DIFR2,D1,D2
  1.  S D1=0
  1.  F  S D1=$O(@DIFRTRT@(40,D1)) Q:'D1  I $D(^(D1,0)) S DIFR1=+$P(^(0),U,2) D
  1.  .I $D(^DIST(.404,DIFR1,0)) D
  1.  ..S $P(@DIFRTRT@(40,D1,0),U,2)=$P(^DIST(.404,DIFR1,0),U)
  1.  ..M @DIFRTA@(.404,DIFR1)=^DIST(.404,DIFR1)
  1.  ..K @DIFRTA@(.404,DIFR1,40,"B"),^("C"),^("D")
  1.  ..Q
  1.  .S D2=0
  1.  .F  S D2=$O(@DIFRTRT@(40,D1,40,D2)) Q:'D2  I $D(^(D2,0)) S DIFR2=+^(0) D
  1.  ..I $D(^DIST(.404,DIFR2)) D
  1.  ...S $P(@DIFRTRT@(40,D1,40,D2,0),U)=$P(^DIST(.404,DIFR2,0),U)
  1.  ...M @DIFRTA@(.404,DIFR2)=^DIST(.404,DIFR2)
  1.  ...K @DIFRTA@(.404,DIFR2,40,"B"),^("C"),^("D")
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. DIALOG ;
  1.  Q:'$D(@DIFRTRT@(0))  K ^(4),^(3,"B")
  1.  Q:$G(DIFRF)'>0
  1.  S:DIFRF DIFRF=$P($G(^DIC(9.4,DIFRF,0)),"^"),$P(@DIFRTRT@(0),"^",4)=DIFRF
  1.  Q