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

DDGFU.m

Go to the documentation of this file. 
  1. DDGFU ;SFISC/MKO-CALLED FROM THE FORMS ;10:49 AM  27 Jul 1995
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. VAL1 ;Data validation code
  1.  ;Form: DDS FIELD ADD
  1.  I $$GET^DDSVALF("BLOCK","DDGF FIELD ADD")]"",$$GET^DDSVALF("FIELD ORDER","DDGF FIELD ADD")]"",$$GET^DDSVALF("FIELD TYPE","DDGF FIELD ADD")]"" Q
  1.  ;
  1.  S DDGFT(1)=$C(7)_"Unable to save values."
  1.  S DDGFT(2)="All values must be filled in order to add a new field."
  1.  D HLP^DDSUTL(.DDGFT)
  1.  S DDSERROR=1
  1.  K DDGFT
  1.  Q
  1.  ;
  1. DDCAP ;Caption, Post action on change
  1.  ;Form:  DDGF FIELD DD
  1.  N DDGFOPG
  1.  S DDGFOPG=$$OTHPG
  1.  D:DDSOLD="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
  1.  ;
  1.  D:X="" CAPNULL(DDGFOPG)
  1.  D:X]"" UPDDC(DDGFOPG)
  1.  Q
  1.  ;
  1. OTHPG() ;Return Other Params page#
  1.  N FLD,SUB,OPG
  1.  S FLD=$$GET^DDSVAL(.4044,.DA,4)
  1.  I FLD D
  1.  . S OPG=11
  1.  . S SUB=+$P($G(^DD(DDGFDD,FLD,0)),U,2)
  1.  . S:SUB OPG=$S(SUB_$P($G(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
  1.  Q $G(OPG)
  1.  ;
  1. FOCAP ;Caption, Post action on change
  1.  ;Form:  DDGF FIELD FORM ONLY
  1.  D:X'="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
  1.  ;
  1.  D:X="" CAPNULL(21)
  1.  D:X]"" UPDDC(21)
  1.  Q
  1.  ;
  1. COMPCAP ;Caption, Post action on change
  1.  ;Form:  DDGF FIELD COMPUTED
  1.  D:X'="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
  1.  ;
  1.  D:X="" CAPNULL(11)
  1.  D:X]"" UPDDC(11)
  1.  Q
  1.  ;
  1. CAPNULL(OPG) ;Caption changed to null
  1.  N DC,SC
  1.  ;
  1.  ;Clear suppress colon
  1.  S SC=$$GET^DDSVALF("SUPPRESS COLON AFTER CAPTION?")
  1.  D PUT^DDSVALF("SUPPRESS COLON AFTER CAPTION?","","","","I")
  1.  Q:'$G(OPG)
  1.  ;
  1.  ;Clear caption coords
  1.  D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,"")
  1.  ;
  1.  ;Move data to the left
  1.  S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
  1.  S $P(DC,",",2)=$P(DC,",",2)-$L(DDSOLD)-1-'SC
  1.  S:$P(DC,",",2)<1 $P(DC,",",2)=1
  1.  D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC,"I")
  1.  Q
  1.  ;
  1. UPDDC(OPG) ;Update data coords
  1.  N DC,COL
  1.  S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
  1.  S COL=$P(DC,",",2),COL=COL+$L(X)-$L(DDSOLD)
  1.  I DDSOLD="" D
  1.  . D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,DC,"I")
  1.  . S COL=COL+2
  1.  S:COL<1 COL=1
  1.  S $P(DC,",",2)=COL
  1.  D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
  1.  Q
  1.  ;
  1. POSTCH1 ;Field, Post Action On Change
  1.  ;Form: DDGF FIELD DD
  1.  ;
  1.  ;Reset (if caption not !M): caption, caption and data coords,
  1.  ; data length
  1.  ;Input:
  1.  ; DDGFPG = Page #
  1.  ; DA(1)  = Block #
  1.  ; DA     = Field order
  1.  ; X      = Fld #
  1.  ; DDSOLD = Prev fld #
  1.  ;
  1.  Q:X=""
  1.  N FILE,FLD,DD,C,C0,CC,DC,SC,L,OPG,OPG0,PLRC
  1.  ;
  1.  S FLD=X
  1.  S FILE=+$P(^DIST(.404,DA(1),0),U,2) Q:'FILE
  1.  S DD=$G(^DD(FILE,FLD,0)) Q:DD?."^"
  1.  S OPG=$$OTHPG
  1.  ;
  1.  S OPG0=11
  1.  I $G(DDSOLD)]"" D
  1.  . N SUB
  1.  . S SUB=+$P($G(^DD(FILE,DDSOLD,0)),U,2)
  1.  . S:SUB OPG0=$S(SUB_$P($G(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
  1.  ;
  1.  S (C,C0)=$$GET^DDSVALF("CAPTION",1,1)
  1.  S:C]"" CC=$$GET^DDSVALF("CAPTION COORDINATE",1,OPG0)
  1.  S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG0)
  1.  ;
  1.  I OPG'=OPG0 D
  1.  . D:C]"" PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
  1.  . D:DC]"" PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
  1.  . D DESTROY^DDSUTL(OPG0)
  1.  . 
  1.  ;
  1.  I $D(DDGFREF),$D(DDGFPG) S PLRC=$P($G(@DDGFREF@("F",DDGFPG)),U,4)
  1.  S PLRC=$S($G(PLRC)]"":PLRC-1,1:IOM-2)-$P($G(@DDGFREF@("F",DDGFPG,DA(1))),U,2)
  1.  S L=$$LENGTH(FILE,FLD) S:'L L=1
  1.  ;
  1.  I C'="!M",$P(DD,U)]"" D
  1.  . S C=$P(DD,U)
  1.  . I $P(DD,U,2),$P($G(^DD(+$P(DD,U,2),.01,0)),U,2)'["W" S C="Select "_C
  1.  . D PUT^DDSVALF("CAPTION",1,1,C)
  1.  . ;
  1.  . I C0="" D
  1.  .. S CC=DC
  1.  .. S $P(DC,",",2)=$P(DC,",",2)+2
  1.  .. D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
  1.  . E  Q:$P(CC,",")'=$P(DC,",")
  1.  . ;
  1.  . S $P(DC,",",2)=$P(DC,",",2)+$L(C)-$L(C0)
  1.  . S:$P(DC,",",2)<1 $P(DC,",",2)=1
  1.  . D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
  1.  ;
  1.  I C0'="!M",$P(DC,",",2)-2+L>PLRC S L=PLRC-$P(DC,",",2)+2
  1.  D PUT^DDSVALF("DATA LENGTH",1,OPG,L)
  1.  Q
  1.  ;
  1. HBVAL ;Validate hdr blk
  1.  Q:X=""  Q:'$O(@(DIE_DA_",40,""B"",X,"""")"))
  1.  S DDSERROR=1
  1.  D HLP^DDSUTL($C(7)_DDSEXT_" already exists on this page.")
  1.  Q
  1.  ;
  1. LENGTH(DIFILE,DIFLD) ;Find max field length
  1.  N DD,DIIT,DILEN,DITYPE
  1.  S DILEN=""
  1.  S DD=$G(^DD(DIFILE,DIFLD,0)) Q:DD?."^" DILEN
  1.  S DITYPE=$P(DD,U,2),DIIT=$P(DD,U,5,999)
  1.  ;
  1.  I DIIT["$L(X)>" S DILEN=+$P($P(DIIT,"$L(X)>",2,999),"E")
  1.  E  I DITYPE["N" S DILEN=+$P(DITYPE,"J",2)
  1.  E  I DITYPE["P" S DILEN=$$LENGTH(+$P(DITYPE,"P",2),.01)
  1.  ;
  1.  E  I DITYPE["S" D
  1.  . N DICODE,DICODEA,DIPC
  1.  . S DICODE=$P(DD,U,3)
  1.  . F DIPC=1:1 S DICODEA=$P(DICODE,";",DIPC) Q:DICODEA=""  D
  1.  .. S DILEN=$$MAX(DILEN,$L($P(DICODEA,":")),$L($P(DICODEA,":",2)))
  1.  ;
  1.  E  I DITYPE["D" D
  1.  . N DIDT
  1.  . S DIDT=$P($P(DIIT,"S %DT=""",2,999),"""")
  1.  . S DILEN=$S(DIDT["S"&(DIDT["T"):20,DIDT["T":17,1:11)
  1.  ;
  1.  E  I DITYPE["V" D
  1.  . N DIL,DIX
  1.  . S DIX=0 F  S DIX=$O(^DD(DIFILE,DIFLD,"V",DIX)) Q:'DIX  D
  1.  .. Q:'$G(^DD(DIFILE,DIFLD,"V",DIX,0))
  1.  .. S DIL=$G(DIL)+1
  1.  .. S DIL(DIL)=$$LENGTH(+^DD(DIFILE,DIFLD,"V",DIX,0),.01)
  1.  . S DILEN=$G(DIL(1))
  1.  . F DIL=1:1:$G(DIL)-1 S DILEN=$$MAX(DIL(DIL),DIL(DIL+1))
  1.  ;
  1.  E  I DITYPE D
  1.  . Q:$D(^DD(+DITYPE,.01,0))[0
  1.  . S DILEN=$S($P(^DD(+DITYPE,.01,0),U,2)["W":1,1:$$LENGTH(+DITYPE,.01))
  1.  ;
  1.  Q DILEN
  1.  ;
  1. MAX(X,Y,Z) ;Return max of 2 or 3 numbers
  1.  N M
  1.  S M=$S(X>Y:+X,1:+Y),M=$S(M>$G(Z):M,1:+$G(Z))
  1.  Q M