Return to DDGFU.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

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