Return to DDSZ.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSZ	;SFISC/MKO-FORM COMPILER ;11:26 AM  16 Nov 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	;Prompt, compile
    6: 	N DDSFRM,DDSDDP,DDSREFS
    7: 	N C,DIC,X,Y
    8: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
    9: 	;
   10: 	S DIC="^DIST(.403,",DIC(0)="AEQZ"
   11: 	D ^DIC K DIC Q:Y=-1!'$D(^DIST(.403,+Y,0))
   12: 	S DDSFRM=Y,DDSDDP=$P(Y(0),U,8)
   13: 	;
   14: 	W !!,"Compiling "_$P(Y,U,2)_" (#"_+Y_") ...",!
   15: 	D EN(DDSFRM,DDSDDP)
   16: 	I $G(DIERR) W $C(7) D MSG^DIALOG("BW")
   17: 	Q
   18: 	;
   19: ALL	;Compile all forms
   20: 	N DDSFRM,DDSDDP,DDSFNUM,DDSREFS
   21: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   22: 	W:'$D(DDSQUIET) !,"Compiling all forms ...",!
   23: 	;
   24: 	S DDSFNUM=0
   25: 	F  S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM  D
   26: 	. Q:$D(^DIST(.403,DDSFNUM,0))[0
   27: 	. S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U),DDSDDP=+$P(^(0),U,8)
   28: 	. S DDSREFS=$$REF^DDS0(DDSFRM)
   29: 	. W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
   30: 	. D EN(DDSFRM,DDSDDP)
   31: 	. I $G(DIERR),'$D(DDSQUIET) W !,$C(7) D MSG^DIALOG("BW") W !
   32: 	Q
   33: 	;
   34: EN(DDSFRM,DDSDDP,DDSREFS)	;Compile a form
   35: 	N DDSDO,DDSPG,DDSNDD,DDSPGRP
   36: 	;
   37: 	S:'$G(DDSDDP) DDSDDP=$P(^DIST(.403,+DDSFRM,0),U,8)
   38: 	S:$G(DDSREFS)="" DDSREFS=$$REF^DDS0(DDSFRM)
   39: 	K @DDSREFS
   40: 	;
   41: 	;Find page groups
   42: 	D PGRP^DDSZ3(+DDSFRM,.DDSPGRP)
   43: 	;
   44: 	S DDSPG=0,(DDSDO,DDSNDD)=1
   45: 	F  S DDSPG=$O(^DIST(.403,+DDSFRM,40,DDSPG)) Q:'DDSPG  D PG(DDSFRM,DDSPG,DDSDDP,.DDSDO,.DDSNDD) Q:$G(DIERR)
   46: 	I $G(DIERR) D ERR(DDSFRM,DDSREFS) Q
   47: 	S $P(^DIST(.403,+DDSFRM,0),U,9,11)=+$G(DDSDO)_U_+$G(DDSNDD)_U_1
   48: 	Q
   49: 	;
   50: PG(DDSFRM,DDSPG,DDSDDP,DDSDO,DDSNDD)	;Compile a page
   51: 	;
   52: 	Q:$D(^DIST(.403,+DDSFRM,40,DDSPG,0))[0
   53: 	D:$P($G(^DIST(.403,+DDSFRM,40,DDSPG,1)),U,2)]"" ASUB^DDSZ3(DDSPG,DDSFRM)
   54: 	;
   55: 	;Get page coordinates
   56: 	S DDSPX=$P(^DIST(.403,+DDSFRM,40,DDSPG,0),U,3)
   57: 	S DDSPY=$P(DDSPX,",")-1,DDSPX=$P(DDSPX,",",2)-1
   58: 	S:DDSPY<0 DDSPY=0 S:DDSPX<0 DDSPX=0
   59: 	;
   60: 	;Compile header block
   61: 	S DDSB=$P($G(^DIST(.403,+DDSFRM,40,DDSPG,0)),U,2)
   62: 	I DDSB]"" D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,"",1,"",.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
   63: 	;
   64: 	;Compile all other blocks on page
   65: 	S DDSBO="" F  S DDSBO=$O(^DIST(.403,+DDSFRM,40,DDSPG,40,"AC",DDSBO)) Q:DDSBO=""  S DDSB=$O(^(DDSBO,0)) Q:'DDSB  D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,"",.DDSDO,.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
   66: 	;
   67: 	D:$D(DDSSCR)!$D(DDSORD) EN^DDSZ2(.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
   68: 	;
   69: END	K DDSB,DDSBO,DDSMUL,DDSNAV,DDSORD
   70: 	K DDSP,DDSPX,DDSPY,DDSREP,DDSRNAV,DDSSCR
   71: 	Q
   72: 	;
   73: BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,DDSH,DDSDO,DDSNDD,DDSSCR,DDSNAV,DDSORD)	;
   74: 	;Compile block
   75: 	; DDSH   = 1 if header block
   76: 	; DDSDO  = killed if any edit blocks
   77: 	; DDSNDD = killed if any DD fields
   78: 	;
   79: 	N DDP
   80: 	I $D(^DIST(.404,DDSB,0))[0 D BLD^DIALOG(3051,"#"_DDSB) Q
   81: 	S DDSDN=$P(^DIST(.404,DDSB,0),U,3),DDP=+$P(^(0),U,2)
   82: 	;
   83: 	S DDSPTB=""
   84: 	S:'$G(DDSH) DDSPTB=$G(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,1))
   85: 	;
   86: 	;Get DDSBY,DDSBX,DDSTP
   87: 	I $G(DDSH) S DDSBY=DDSPY,DDSBX=DDSPX,DDSTP="h",DDSREP=1
   88: 	E  D
   89: 	. S DDSBX=$P(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,0),U,3),DDSTP=$P(^(0),U,4) S DDSREP=$S($G(^(2)):^(2),1:1)
   90: 	. K:DDSTP="e" DDSDO
   91: 	. S DDSBY=$P(DDSBX,",")-1,DDSBX=$P(DDSBX,",",2)-1
   92: 	. S:DDSBY<0 DDSBY=0 S:DDSBX<0 DDSBX=0
   93: 	. S DDSBY=DDSBY+DDSPY,DDSBX=DDSBX+DDSPX
   94: 	;
   95: 	;Set @DDSREFS@(DDSPG,DDSB)
   96: 	S @DDSREFS@(DDSPG,DDSB)=DDSBY_U_DDSBX_U_$P($G(^DIST(.404,DDSB,0)),U,2)_U_DDSDN_U_DDSTP_$S(DDSREP>1:U_U_+DDSREP,1:"")
   97: 	;
   98: 	D:DDSPTB]"" PT^DDSPTR(DDSDDP,DDSPTB,DDSFRM,DDSPG,DDSB)
   99: 	D EN^DDSZ1(DDSPG,DDSB,DDP,DDSBY,DDSBX,DDSBO,DDSTP,DDSREP,.DDSNDD,.DDSPGRP,.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
  100: 	;
  101: 	K DDSBX,DDSBY,DDSDN,DDSPTB,DDSTP
  102: 	Q
  103: 	;
  104: DELALL	;Delete compile global for all forms
  105: 	N DDSFRM,DDSFNUM,DDSREFS
  106: 	W:'$D(DDSQUIET) !,"Deleting compiled form data ...",!
  107: 	;
  108: 	S DDSFNUM=0
  109: 	F  S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM  D
  110: 	. Q:$D(^DIST(.403,DDSFNUM,0))[0
  111: 	. S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U)
  112: 	. S DDSREFS=$$REF^DDS0(DDSFRM)
  113: 	. W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
  114: 	. D DEL(DDSFRM)
  115: 	Q
  116: 	;
  117: DEL(DDSFRM)	;Delete compiled global
  118: 	N DDSREFS
  119: 	S DDSREFS=$$REF^DDS0(DDSFRM) K @DDSREFS
  120: 	S $P(^DIST(.403,+DDSFRM,0),U,11)=""
  121: 	Q
  122: 	;
  123: ERR(DDSFRM,DDSREFS)	;Print error, kill compiled global
  124: 	Q:'$G(DIERR)
  125: 	N DDSNAM
  126: 	S DDSNAM=$P(DDSFRM,U,2)
  127: 	S:DDSNAM="" DDSNAM=$P($G(^DIST(.403,+DDSFRM,0)),U)
  128: 	D BLD^DIALOG(3002,DDSNAM)
  129: 	S $P(^DIST(.403,+DDSFRM,0),U,11)=""
  130: 	K @DDSREFS
  131: 	Q