File:  [Coherent Logic Development] / freem_fileman / USER / DIEZ.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIEZ	;SFISC/GFT-COMPILE INPUT TEMPLATE ;10/4/94  11:18
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	I $G(DUZ(0))'="@" W $C(7),$$EZBLD^DIALOG(101) G K
    5: EN1	D:'$D(DISYS) OS^DII I '$D(^DD("OS",DISYS,"ZS")) W $$EZBLD^DIALOG(820),$C(7) G K
    6: 	S U="^" S:'$G(DTIME) DTIME=300 N L,DNM
    7: 	D SIZ^DIPZ0(8033) G:$D(DTOUT)!($D(DUOUT))!('X) K S DMAX=X Q:$D(DIX)
    8: TEM	K DIC S DIC="^DIE(",DIC(0)="AEQ",DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,^(""ROU"")",DIC("S")="I Y'<1" D ^DIC G:'$D(^DIE(+Y,"DR")) K S DIPZ=+Y
    9: 	D RNM^DIPZ0(8033) G:$D(DTOUT)!($D(DUOUT))!(X="") K S DNM=X K DIC
   10: 	W ! S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(8020) D ^DIR K DIR G:'Y!($D(DIRUT)) K
   11: 	S X=DNM,Y=DIPZ K DIPZ
   12: EN	;
   13: 	W:'$G(DIEZS) ! K ^UTILITY($J),DRN N L,DIEZQ,DIR S DMAX=DMAX-2150,DNM=X,DIEZ=+Y,DRN="",DRD=0,DIEZQ=0
   14: 	S DP=$P(^DIE(DIEZ,0),U,4),DIE=^DIC(DP,0,"GL")
   15: 	I '$D(^DIE(DIEZ,"DR",1,DP)) S ^DIE(DIEZ,"DR",1,DP)=^DIE(DIEZ,"DR")
   16: 	D DT^DICRW S X=-1
   17: 	K T S T(1)=$P(^DIE(DIEZ,0),U),T(2)=$$EZBLD^DIALOG(8033),T(3)=DP D BLD^DIALOG(8024,.T,"","DIR") W:'$G(DIEZS) !,DIR K T
   18: 	F T=0:0 S X=$O(^DIE("AF",X)) Q:X=""  K:'X ^(X,DIEZ) S %=0 F  S %=$O(^DIE("AF",X,%)) Q:%'>0  K:$D(^(%,DIEZ)) ^(DIEZ)
   19: 	K DOV,^DIE(DIEZ,"RD"),DR S DR=^("DR",1,DP),DL=1,DIEZL=0,DIEZAB=U
   20: 	D NEWROU F %=0:0 S %=$O(^DIE(DIEZ,"DR",99,%)) Q:%=""  F %Y=0:0 S %Y=$O(^DIE(DIEZ,"DR",99,%,%Y)) Q:%Y=""  S F=0,Q=^DIE(DIEZ,"DR",99,%,%Y) D QFF^DIEZ2 S X=" S DR(99,"_%_","_%Y_")="_Q D L^DIEZ2
   21: 	S X=" S:$D(DTIME)[0 DTIME=300 S D0=DA,DIEZ="_DIEZ_",U=""^""" G ^DIEZ0
   22: 	;
   23: NEWROU	;
   24: 	K ^UTILITY($J,0) S DQ=0,T=99,L=3
   25: 	S ^UTILITY($J,0,1)=DNM_DRN_" ; "_$P("GENERATED FROM '"_$P(^DIE(DIEZ,0),U,1)_"' INPUT TEMPLATE(#"_DIEZ_"), FILE "_DP,U,DRN="")_";"_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),^(2)=" D DE G BEGIN",^(3)="BEGIN S DNM="""_DNM_DRN_""",DQ=1"
   26: 	Q
   27: 	;
   28: EN2(Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZZMSG)	;Silent or Talking with parameter passing
   29: 	;and optionally return list of routines built and if successful
   30: 	;IEN,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
   31: 	;Y=TEMPLATE IEN (required)
   32: 	;FLAGS="T"alk  (optional)
   33: 	;X=ROUTINE NAME (required)
   34: 	;DMAX=ROUTINE SIZE (optional)
   35: 	;DIEZRLA=ROUTINE LIST ARRAY, by value (optional)
   36: 	;DIEZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
   37: 	;*
   38: 	;DIEZS will be used to indicate "silent" if set to 1
   39: 	;Write statements are made conditional, if not "silent"
   40: 	;*
   41: 	N DIEZS,DNM,DIQUIET,DIEZRIEN,DIEZRLAZ,DIEZRLAF
   42: 	N DIK,DIC,%I,DICS
   43: 	S DIEZS=$G(DIEZFLGS)'["T"
   44: 	S:DIEZS DIQUIET=1
   45: 	I '$D(DIFM) N DIFM S DIFM=1 D
   46: 	.N Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZS
   47: 	.D INIZE^DIEFU
   48: 	I $G(Y)'>0 D BLD^DIALOG(1700,"IEN for Edit Template missing or invalid") G EN2E
   49: 	I '$D(^DIE(Y,0)) D BLD^DIALOG(1700,"No Edit Template on file with IEN="_Y) G EN2E
   50: 	I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing this Edit Template, IEN="_Y) G EN2E
   51: 	I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
   52: 	I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
   53: 	S DIEZRLA=$G(DIEZRLA,"DIEZRLAZ"),DIEZRIEN=Y
   54: 	S:DIEZRLA="" DIEZRLA="DIEZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
   55: 	S DIEZRLAF=""
   56: 	K @DIEZRLA
   57: 	D EN
   58: 	G:'DIEZS!(DIEZRLAF) EN2E
   59: 	D BLD^DIALOG(1700,"Compiling Edit Template (IEN="_DIEZRIEN_")"_$S(DIEZRLAF=0:", routine name too long",1:""))
   60: EN2E	I 'DIEZS D MSG^DIALOG() Q
   61: 	I $G(DIEZZMSG)]"" D CALLOUT^DIEFU(DIEZZMSG)
   62: 	Q
   63: 	;
   64: RECOMP	S DIX=1 D DIEZ Q:'$D(DIX)  N DIMAX S DIMAX=DMAX
   65: 	F DIX=0:0 S DIX=$O(^DIE(DIX)) Q:DIX'>0  I $D(^(DIX,0)),$D(^("ROU")) S %=$P(^(0),"^",1),X=$E(^("ROU"),2,99) I X]"" S Y=DIX,DMAX=DIMAX D EN
   66: 	;
   67: K	K %,DDH,DIC,DIX,DIPZ,DMAX,DNM,DTOUT,DIRUT,DIROUT,DUOUT,X,Y Q
   68: 	;DIALOG #101  'only those with programmer's access'
   69: 	;       #820  'no way to save routines on the system'
   70: 	;       #8020 'Should the compilation run now?'
   71: 	;       #8024 'Compiling template name Input template of file n'
   72: 	;       #8033 'Input template'

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>