Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIEZ.m

    r613 r623  
    1 DIEZ    ;SFISC/GFT-COMPILE INPUT TEMPLATE ;13SEP2004
    2         ;;22.0;VA FileMan;**1,11,159**;Mar 30, 1999;Build 8
    3         ;Per VHA Directive 2004-038, 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         D UNCAF(DIEZ)
    19         K DOV,^DIE(DIEZ,"RD"),DR S DR=^("DR",1,DP),(DIER,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=" N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1(""DIEZ"")" D L^DIEZ2
    22         S X=" M DIEZAR=^DIE("_DIEZ_",""AR"") S DICRREC=""TRIG^DIE17""" D L^DIEZ2
    23         N DIEZTMP S DIEZTMP=$$GETTMP^DIKC1("DIEZ")
    24         S X=" S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_"","",DIEZ="_DIEZ_",U=""^""" G ^DIEZ0
    25         ;
    26 NEWROU  ;
    27         K ^UTILITY($J,0) S DQ=0,T=99,L=3
    28         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)
    29         S ^UTILITY($J,0,2)=" D DE G BEGIN"
    30         S ^UTILITY($J,0,3)="BEGIN S DNM="""_DNM_DRN_""",DQ=1"
    31         I '$D(DRN(+DRN)) S DRN(+DRN)=U
    32         Q
    33         ;
    34 EN2(Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZZMSG) ;Silent or Talking with parameter passing
    35         ;and optionally return list of routines built and if successful
    36         ;IEN,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
    37         ;Y=TEMPLATE IEN (required)
    38         ;FLAGS="T"alk  (optional)
    39         ;X=ROUTINE NAME (required)
    40         ;DMAX=ROUTINE SIZE (optional)
    41         ;DIEZRLA=ROUTINE LIST ARRAY, by value (optional)
    42         ;DIEZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
    43         ;*
    44         ;DIEZS will be used to indicate "silent" if set to 1
    45         ;Write statements are made conditional, if not "silent"
    46         ;*
    47         N DIEZS,DNM,DIQUIET,DIEZRIEN,DIEZRLAZ,DIEZRLAF
    48         N DIK,DIC,%I,DICS
    49         S DIEZS=$G(DIEZFLGS)'["T"
    50         S:DIEZS DIQUIET=1
    51         I '$D(DIFM) N DIFM S DIFM=1 D
    52         .N Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZS
    53         .D INIZE^DIEFU
    54         I $G(Y)'>0 D BLD^DIALOG(1700,"IEN for Edit Template missing or invalid") G EN2E
    55         I '$D(^DIE(Y,0)) D BLD^DIALOG(1700,"No Edit Template on file with IEN="_Y) G EN2E
    56         I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing this Edit Template, IEN="_Y) G EN2E
    57         I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
    58         I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
    59         S DIEZRLA=$G(DIEZRLA,"DIEZRLAZ"),DIEZRIEN=Y
    60         S:DIEZRLA="" DIEZRLA="DIEZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
    61         S DIEZRLAF=""
    62         K @DIEZRLA
    63         D EN
    64         G:'DIEZS!(DIEZRLAF) EN2E
    65         D BLD^DIALOG(1700,"Compiling Edit Template (IEN="_DIEZRIEN_")"_$S(DIEZRLAF=0:", routine name too long",1:""))
    66 EN2E    I 'DIEZS D MSG^DIALOG() Q
    67         I $G(DIEZZMSG)]"" D CALLOUT^DIEFU(DIEZZMSG)
    68         Q
    69         ;
    70 RECOMP  S DIX=1 D DIEZ Q:'$D(DIX)  N DIMAX S DIMAX=DMAX
    71         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
    72         ;
    73 K       K %,DDH,DIC,DIX,DIPZ,DMAX,DNM,DTOUT,DIRUT,DIROUT,DUOUT,X,Y Q
    74         ;DIALOG #101  'only those with programmer's access'
    75         ;       #820  'no way to save routines on the system'
    76         ;       #8020 'Should the compilation run now?'
    77         ;       #8024 'Compiling template name Input template of file n'
    78         ;       #8033 'Input template'
    79 UNCAF(DIEZ)     ;
    80         ; for one compiled input template (DIEZ), delete its "AF" entries
    81         N %,X S X=""
    82         F  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)
    83         Q
    84         ;
    85 UNC(DIEZ,DIFLAGS)       ;
    86         ; DBS: silent entry point to uncompile an input template
    87         ; DIEZ = IEN of input template to uncompile
    88         ; DIFLAGS = flags:
    89         ;     D = compiled routines are also deleted
    90         K ^DIE(DIEZ,"ROU")
    91         D UNCAF(DIEZ)
    92         I $G(DIFLAGS)["D" D
    93         . N DINAME S DINAME=$G(^DIE(DIEZ,"ROUOLD")) Q:DINAME=""
    94         . N DIROU,DISUF F DISUF="",1:1 D  Q:DIROU=""
    95         . . S DIROU=DINAME_DISUF I '$$ROUEXIST^DILIBF(DIROU) S DIROU="" Q
    96         . . N X S X=DIROU X ^%ZOSF("DEL")
    97         Q
     1DIEZ ;SFISC/GFT-COMPILE INPUT TEMPLATE ;2:00 PM  30 Jul 1999
     2 ;;22.0;VA FileMan;**1,11**;Mar 30, 1999
     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
     5EN1 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)
     8TEM 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
     12EN ;
     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 D UNCAF(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=" N DIEZTMP,DIEZAR,DIEZRXR,DIIENS,DIXR K DIEFIRE,DIEBADK S DIEZTMP=$$GETTMP^DIKC1(""DIEZ"")" D L^DIEZ2
     22 S X=" M DIEZAR=^DIE("_DIEZ_",""AR"") S DICRREC=""TRIG^DIE17""" D L^DIEZ2
     23 N DIEZTMP S DIEZTMP=$$GETTMP^DIKC1("DIEZ")
     24 S X=" S:$D(DTIME)[0 DTIME=300 S D0=DA,DIIENS=DA_"","",DIEZ="_DIEZ_",U=""^""" G ^DIEZ0
     25 ;
     26NEWROU ;
     27 K ^UTILITY($J,0) S DQ=0,T=99,L=3
     28 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)
     29 S ^UTILITY($J,0,2)=" D DE G BEGIN"
     30 S ^UTILITY($J,0,3)="BEGIN S DNM="""_DNM_DRN_""",DQ=1"
     31 I '$D(DRN(+DRN)) S DRN(+DRN)=U
     32 Q
     33 ;
     34EN2(Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZZMSG) ;Silent or Talking with parameter passing
     35 ;and optionally return list of routines built and if successful
     36 ;IEN,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
     37 ;Y=TEMPLATE IEN (required)
     38 ;FLAGS="T"alk  (optional)
     39 ;X=ROUTINE NAME (required)
     40 ;DMAX=ROUTINE SIZE (optional)
     41 ;DIEZRLA=ROUTINE LIST ARRAY, by value (optional)
     42 ;DIEZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
     43 ;*
     44 ;DIEZS will be used to indicate "silent" if set to 1
     45 ;Write statements are made conditional, if not "silent"
     46 ;*
     47 N DIEZS,DNM,DIQUIET,DIEZRIEN,DIEZRLAZ,DIEZRLAF
     48 N DIK,DIC,%I,DICS
     49 S DIEZS=$G(DIEZFLGS)'["T"
     50 S:DIEZS DIQUIET=1
     51 I '$D(DIFM) N DIFM S DIFM=1 D
     52 .N Y,DIEZFLGS,X,DMAX,DIEZRLA,DIEZS
     53 .D INIZE^DIEFU
     54 I $G(Y)'>0 D BLD^DIALOG(1700,"IEN for Edit Template missing or invalid") G EN2E
     55 I '$D(^DIE(Y,0)) D BLD^DIALOG(1700,"No Edit Template on file with IEN="_Y) G EN2E
     56 I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing this Edit Template, IEN="_Y) G EN2E
     57 I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
     58 I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
     59 S DIEZRLA=$G(DIEZRLA,"DIEZRLAZ"),DIEZRIEN=Y
     60 S:DIEZRLA="" DIEZRLA="DIEZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
     61 S DIEZRLAF=""
     62 K @DIEZRLA
     63 D EN
     64 G:'DIEZS!(DIEZRLAF) EN2E
     65 D BLD^DIALOG(1700,"Compiling Edit Template (IEN="_DIEZRIEN_")"_$S(DIEZRLAF=0:", routine name too long",1:""))
     66EN2E I 'DIEZS D MSG^DIALOG() Q
     67 I $G(DIEZZMSG)]"" D CALLOUT^DIEFU(DIEZZMSG)
     68 Q
     69 ;
     70RECOMP S DIX=1 D DIEZ Q:'$D(DIX)  N DIMAX S DIMAX=DMAX
     71 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
     72 ;
     73K K %,DDH,DIC,DIX,DIPZ,DMAX,DNM,DTOUT,DIRUT,DIROUT,DUOUT,X,Y Q
     74 ;DIALOG #101  'only those with programmer's access'
     75 ;       #820  'no way to save routines on the system'
     76 ;       #8020 'Should the compilation run now?'
     77 ;       #8024 'Compiling template name Input template of file n'
     78 ;       #8033 'Input template'
     79UNCAF(DIEZ) ;
     80 ; for one compiled input template (DIEZ), delete its "AF" entries
     81 N %,X S X=""
     82 F  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)
     83 Q
     84 ;
     85UNC(DIEZ,DIFLAGS) ;
     86 ; DBS: silent entry point to uncompile an input template
     87 ; DIEZ = IEN of input template to uncompile
     88 ; DIFLAGS = flags:
     89 ;     D = compiled routines are also deleted
     90 K ^DIE(DIEZ,"ROU")
     91 D UNCAF(DIEZ)
     92 I $G(DIFLAGS)["D" D
     93 . N DINAME S DINAME=$G(^DIE(DIEZ,"ROUOLD")) Q:DINAME=""
     94 . N DIROU,DISUF F DISUF="",1:1 D  Q:DIROU=""
     95 . . S DIROU=DINAME_DISUF I '$$ROUEXIST^DILIBF(DIROU) S DIROU="" Q
     96 . . N X S X=DIROU X ^%ZOSF("DEL")
     97 Q
Note: See TracChangeset for help on using the changeset viewer.