Return to DDS0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDS0	;SFISC/MLH-SETUP, CLEANUP ;09:38 AM  30 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: EN(DDSFILE,DR,DA)	;Initial setup
    6: 	S U="^"
    7: 	D INIT^DDGLIB0() Q:$G(DIERR)
    8: 	D FORM(.DDSFILE,DR) Q:$G(DIERR)
    9: 	;
   10: 	;Compile the form if not already compiled
   11: 	S DDSREFS=$$REF(DDS)
   12: 	I '$$COMPILED(DDS) D EN^DDSZ(DDS) Q:$G(DIERR)
   13: 	S:$P(^DIST(.403,+DDS,0),U,10) DA="NOREC"
   14: 	;
   15: 	D FRSTPG(DDS,.DA,$G(DDSPAGE)) Q:$G(DIERR)
   16: 	D REC(DDP,.DA) Q:$G(DIERR)
   17: 	D INIT
   18: 	Q
   19: 	;
   20: FORM(DDSFILE,DR)	;Form lookup
   21: 	;Output:
   22: 	;  DDS     = Form number^Form name
   23: 	;  DDP     = File number (or 0)
   24: 	;  DDSPG   = First page to go to on form
   25: 	;  DIERR
   26: 	;
   27: 	I $D(DDSFILE)[0 D BLD^DIALOG(201,"DDSFILE") Q
   28: 	;
   29: 	N DIC,X,Y
   30: 	;
   31: 	S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
   32: 	S X=$S(DR:DR,1:$P($P(DR,"[",2),"]"))
   33: 	S DIC="^DIST(.403,",DIC(0)="FNX",D="F"_DDP
   34: 	D IX^DIC K DIC
   35: 	;
   36: 	I Y<0 D BLD^DIALOG(3021,X) Q
   37: 	I '$O(^DIST(.403,+Y,40,"B","")) D BLD^DIALOG(3022,X) Q
   38: 	S DDS=Y
   39: 	;
   40: 	I $D(DDSFILE(1))#2 S DDP=$S(DDSFILE(1)=+DDSFILE(1):DDSFILE(1),1:+$P($G(@(DDSFILE(1)_"0)")),U,2))
   41: 	Q
   42: 	;
   43: FRSTPG(DDS,DA,DDSPAGE)	;Get first page of form
   44: 	;Output:
   45: 	;  DDSPG
   46: 	;  DDSSEL = 1, if DA is null and there is a record selection page
   47: 	;  DIERR
   48: 	;
   49: 	N P
   50: 	I $G(DA)!($G(DA)="NOREC") D
   51: 	. S P=$S($G(DDSPAGE):DDSPAGE,1:1)
   52: 	. S DDSPG=$O(^DIST(.403,+DDS,40,"B",P,""))
   53: 	. I $D(^DIST(.403,+DDS,40,+DDSPG,0))[0 D BLD^DIALOG(3023,"number "_P)
   54: 	E  D PG^DDSRSEL D:'$G(DDSSEL) BLD^DIALOG(202,"record")
   55: 	Q
   56: 	;
   57: REC(DDP,DA)	;Check record and lock
   58: 	;Output:
   59: 	;  DIE      = Global root
   60: 	;  DDSDA    = DA,DA(1),...,
   61: 	;  DDSDAORG = Original DA array
   62: 	;  DDSDL    = Level number (top=0)
   63: 	;  DDSDLORG = Original level number
   64: 	;  DDSFLORG  = Orig DDP^Orig DIE
   65: 	;  D0,D1,etc.
   66: 	;  DIERR
   67: 	;
   68: 	I '$G(DA) D  Q
   69: 	. S DIE="",(DDSDL,DDSDLORG)=0,DDSDA="0,"
   70: 	. S:'$D(DA) DA="" S DDSDAORG=DA
   71: 	;
   72: 	D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1) Q:$G(DIERR)
   73: 	;
   74: 	I $D(DIOVRD)[0 D  Q:$G(DIERR)
   75: 	. N DDSTOP S DDSTOP=$$FNO^DILIBF(DDP)
   76: 	. Q:$P($G(^DD(DDSTOP,0,"DI")),U,2)'["Y"
   77: 	. N P S P("FILE")=$P(@(DIE_"0)"),U)
   78: 	. D BLD^DIALOG(405,DDSTOP,.P)
   79: 	;
   80: 	S DDSDLORG=DDSDL
   81: 	K DDSDAORG S (DDSDAORG,@("D"_DDSDL))=DA
   82: 	F DDSI=1:1:DDSDL S (DDSDAORG(DDSI),@("D"_(DDSDL-DDSI)))=DA(DDSI)
   83: 	S DDSFLORG=$G(DDP)_$G(DIE)
   84: 	K DDSI
   85: 	Q
   86: 	;
   87: INIT	;Initialize some variables
   88: 	; DDSHBX   = $Y of first line of help area
   89: 	; DDSREFT  = Global reference of temporary global location
   90: 	; DDSFDO   = 1 if entire form is display-only
   91: 	; DDSCHG   = Change flag
   92: 	; DDSKM    = Flag to keep whatever's in help area
   93: 	; DDSH     = Flag to indicate help area is empty
   94: 	; DDSSC    = Array to indicate what pages are on the screen
   95: 	;
   96: 	S DDSHBX=IOSL-7
   97: 	S DDXY=IOXY_" S $X=DX,$Y=DY"
   98: 	;
   99: 	K DDH,DDSSC,DDSCHANG,DDSSAVE
  100: 	S DDSH=1,(DDH,DDM,DDSCHG,DDSSC)=0,DDACT="N"
  101: 	S DDSREFT="^TMP(""DDS"",$J,"_+DDS_")"
  102: 	;
  103: 	N %,%H,%I,X
  104: 	D NOW^%DTC
  105: 	S $P(^DIST(.403,+DDS,0),U,6)=$E(%,1,12)
  106: 	Q
  107: 	;
  108: END	I $D(DDSHBX) S DX=0,DY=IOSL-1 X IOXY
  109: 	D KILL^DDGLIB0($G(DDSPARM))
  110: 	;
  111: 	I $D(^TMP("DDS",$J,"LOCK")) D
  112: 	. N I
  113: 	. S I="" F  S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I=""  L -@I
  114: 	. K ^TMP("DDS",$J,"LOCK")
  115: 	;
  116: 	K:'$G(DA) DA
  117: 	I $D(DA),$D(DDSDAORG)#2,$D(DDSDLORG)#2 D
  118: 	. K DA,D0
  119: 	. S DA=DDSDAORG
  120: 	. F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI) K @("D"_DDSI)
  121: 	;
  122: 	K:$G(DDSPARM)'["E" DIERR,^TMP("DIERR",$J)
  123: 	K:$D(DDSREFT)#2 @DDSREFT,DDSREFT
  124: 	K ^TMP("DDSH",$J),^TMP("DDSWP",$J)
  125: 	K DDACT,DDH,DDM,DDO,DDP,DDQ,DDS,DDSDDP
  126: 	K DDSBK,DDSBR,DDSCHG,DDSDA,DDSDAORG,DDSDL
  127: 	K DDSDLORG,DDSDN,DDSEXT,DDSFDO,DDSFLD,DDSFLORG,DDSGL,DDSH,DDSI
  128: 	K DDSKM,DDSLN,DDSNP,DDSO,DDSOLD,DDSORD,DDSOPB,DDSOSV,DDSPTB,DDSPG
  129: 	K DDSPX,DDSPY,DDSQ,DDSREP,DDSSC,DDSSP,DDSTP,DDSU,DDSX
  130: 	K DDSHBX,DDSREFS,DDXY
  131: 	K DIC,DIR,DIR0N,DIROUT,DIRUT,DUOUT,DY,DX
  132: 	K A1,D,DDC,DDD,DI,DIEQ,DIK,DIW,DIY,DIZ,DS
  133: 	Q
  134: 	;
  135: COMPILED(DDS)	;Return 1 if form is compiled
  136: 	Q $D(@$$REF(DDS))>0
  137: 	;
  138: REF(DDS)	;Return global reference for compiled global
  139: 	;Q "^DIST(.403,""AZ"","_+DDS_")"
  140: 	Q "^DIST(.403,"_+DDS_",""AZ"")"
  141: 	;
  142: IXF	;
  143: 	N D0,DA,DIC,DP,Y S DIC="^DD("_DDGFDD_",",DIC(0)="EMN" D ^DIC
  144: 	I Y'>0 K X
  145: 	E  S X=+$P(Y,"E")
  146: 	Q