186 lines
4.8 KiB
Mathematica
186 lines
4.8 KiB
Mathematica
DDGFU ;SFISC/MKO-CALLED FROM THE FORMS ;10:49 AM 27 Jul 1995
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;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 Params 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 coords
|
|
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 coords
|
|
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
|
|
;
|
|
;Reset (if caption not !M): caption, caption and data coords,
|
|
; data length
|
|
;Input:
|
|
; DDGFPG = Page #
|
|
; DA(1) = Block #
|
|
; DA = Field order
|
|
; X = Fld #
|
|
; DDSOLD = Prev fld #
|
|
;
|
|
Q:X=""
|
|
N FILE,FLD,DD,C,C0,CC,DC,SC,L,OPG,OPG0,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 OPG=$$OTHPG
|
|
;
|
|
S OPG0=11
|
|
I $G(DDSOLD)]"" D
|
|
. N SUB
|
|
. S SUB=+$P($G(^DD(FILE,DDSOLD,0)),U,2)
|
|
. S:SUB OPG0=$S(SUB_$P($G(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
|
|
;
|
|
S (C,C0)=$$GET^DDSVALF("CAPTION",1,1)
|
|
S:C]"" CC=$$GET^DDSVALF("CAPTION COORDINATE",1,OPG0)
|
|
S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG0)
|
|
;
|
|
I OPG'=OPG0 D
|
|
. D:C]"" PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
|
|
. D:DC]"" PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
|
|
. D DESTROY^DDSUTL(OPG0)
|
|
.
|
|
;
|
|
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,OPG,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,OPG,DC)
|
|
;
|
|
I C0'="!M",$P(DC,",",2)-2+L>PLRC S L=PLRC-$P(DC,",",2)+2
|
|
D PUT^DDSVALF("DATA LENGTH",1,OPG,L)
|
|
Q
|
|
;
|
|
HBVAL ;Validate hdr blk
|
|
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 max field length
|
|
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 max of 2 or 3 numbers
|
|
N M
|
|
S M=$S(X>Y:+X,1:+Y),M=$S(M>$G(Z):M,1:+$G(Z))
|
|
Q M
|