DDGFU ;SFISC/MKO - CALLED FROM THE FORMS ;25DEC2015
;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;
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)
L S L=$$GET1^DID(FILE,FLD,,"FIELD LENGTH") S:'L L=1 ;S L=$$LENGTH(FILE,FLD)
;
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 -NO LONGER USED!
;...
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFU 4200 printed Nov 22, 2024@17:52:25 Page 2
DDGFU ;SFISC/MKO - CALLED FROM THE FORMS ;25DEC2015
+1 ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;
VAL1 ;Data validation code
+1 ;Form: DDS FIELD ADD
+2 IF $$GET^DDSVALF("BLOCK","DDGF FIELD ADD")]""
IF $$GET^DDSVALF("FIELD ORDER","DDGF FIELD ADD")]""
IF $$GET^DDSVALF("FIELD TYPE","DDGF FIELD ADD")]""
QUIT
+3 ;
+4 SET DDGFT(1)=$CHAR(7)_"Unable to save values."
+5 SET DDGFT(2)="All values must be filled in order to add a new field."
+6 DO HLP^DDSUTL(.DDGFT)
+7 SET DDSERROR=1
+8 KILL DDGFT
+9 QUIT
+10 ;
DDCAP ;Caption, Post action on change
+1 ;Form: DDGF FIELD DD
+2 NEW DDGFOPG
+3 SET DDGFOPG=$$OTHPG
+4 if DDSOLD="!M"
DO PUT^DDSVAL(.4044,.DA,1.1,"")
+5 ;
+6 if X=""
DO CAPNULL(DDGFOPG)
+7 if X]""
DO UPDDC(DDGFOPG)
+8 QUIT
+9 ;
OTHPG() ;Return Other Params page#
+1 NEW FLD,SUB,OPG
+2 SET FLD=$$GET^DDSVAL(.4044,.DA,4)
+3 IF FLD
Begin DoDot:1
+4 SET OPG=11
+5 SET SUB=+$PIECE($GET(^DD(DDGFDD,FLD,0)),U,2)
+6 if SUB
SET OPG=$SELECT(SUB_$PIECE($GET(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
End DoDot:1
+7 QUIT $GET(OPG)
+8 ;
FOCAP ;Caption, Post action on change
+1 ;Form: DDGF FIELD FORM ONLY
+2 if X'="!M"
DO PUT^DDSVAL(.4044,.DA,1.1,"")
+3 ;
+4 if X=""
DO CAPNULL(21)
+5 if X]""
DO UPDDC(21)
+6 QUIT
+7 ;
COMPCAP ;Caption, Post action on change
+1 ;Form: DDGF FIELD COMPUTED
+2 if X'="!M"
DO PUT^DDSVAL(.4044,.DA,1.1,"")
+3 ;
+4 if X=""
DO CAPNULL(11)
+5 if X]""
DO UPDDC(11)
+6 QUIT
+7 ;
CAPNULL(OPG) ;Caption changed to null
+1 NEW DC,SC
+2 ;
+3 ;Clear suppress colon
+4 SET SC=$$GET^DDSVALF("SUPPRESS COLON AFTER CAPTION?")
+5 DO PUT^DDSVALF("SUPPRESS COLON AFTER CAPTION?","","","","I")
+6 if '$GET(OPG)
QUIT
+7 ;
+8 ;Clear caption coords
+9 DO PUT^DDSVALF("CAPTION COORDINATE",1,OPG,"")
+10 ;
+11 ;Move data to the left
+12 SET DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
+13 SET $PIECE(DC,",",2)=$PIECE(DC,",",2)-$LENGTH(DDSOLD)-1-'SC
+14 if $PIECE(DC,",",2)<1
SET $PIECE(DC,",",2)=1
+15 DO PUT^DDSVALF("DATA COORDINATE",1,OPG,DC,"I")
+16 QUIT
+17 ;
UPDDC(OPG) ;Update data coords
+1 NEW DC,COL
+2 SET DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
+3 SET COL=$PIECE(DC,",",2)
SET COL=COL+$LENGTH(X)-$LENGTH(DDSOLD)
+4 IF DDSOLD=""
Begin DoDot:1
+5 DO PUT^DDSVALF("CAPTION COORDINATE",1,OPG,DC,"I")
+6 SET COL=COL+2
End DoDot:1
+7 if COL<1
SET COL=1
+8 SET $PIECE(DC,",",2)=COL
+9 DO PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
+10 QUIT
+11 ;
POSTCH1 ;Field, Post Action On Change
+1 ;Form: DDGF FIELD DD
+2 ;
+3 ;Reset (if caption not !M): caption, caption and data coords,
+4 ; data length
+5 ;Input:
+6 ; DDGFPG = Page #
+7 ; DA(1) = Block #
+8 ; DA = Field order
+9 ; X = Fld #
+10 ; DDSOLD = Prev fld #
+11 ;
+12 if X=""
QUIT
+13 NEW FILE,FLD,DD,C,C0,CC,DC,SC,L,OPG,OPG0,PLRC
+14 ;
+15 SET FLD=X
+16 SET FILE=+$PIECE(^DIST(.404,DA(1),0),U,2)
if 'FILE
QUIT
+17 SET DD=$GET(^DD(FILE,FLD,0))
if DD?."^"
QUIT
+18 SET OPG=$$OTHPG
+19 ;
+20 SET OPG0=11
+21 IF $GET(DDSOLD)]""
Begin DoDot:1
+22 NEW SUB
+23 SET SUB=+$PIECE($GET(^DD(FILE,DDSOLD,0)),U,2)
+24 if SUB
SET OPG0=$SELECT(SUB_$PIECE($GET(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
End DoDot:1
+25 ;
+26 SET (C,C0)=$$GET^DDSVALF("CAPTION",1,1)
+27 if C]""
SET CC=$$GET^DDSVALF("CAPTION COORDINATE",1,OPG0)
+28 SET DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG0)
+29 ;
+30 IF OPG'=OPG0
Begin DoDot:1
+31 if C]""
DO PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
+32 if DC]""
DO PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
+33 DO DESTROY^DDSUTL(OPG0)
+34 End DoDot:1
+35 ;
+36 IF $DATA(DDGFREF)
IF $DATA(DDGFPG)
SET PLRC=$PIECE($GET(@DDGFREF@("F",DDGFPG)),U,4)
+37 SET PLRC=$SELECT($GET(PLRC)]"":PLRC-1,1:IOM-2)-$PIECE($GET(@DDGFREF@("F",DDGFPG,DA(1))),U,2)
L ;S L=$$LENGTH(FILE,FLD)
SET L=$$GET1^DID(FILE,FLD,,"FIELD LENGTH")
if 'L
SET L=1
+1 ;
+2 IF C'="!M"
IF $PIECE(DD,U)]""
Begin DoDot:1
+3 SET C=$PIECE(DD,U)
+4 IF $PIECE(DD,U,2)
IF $PIECE($GET(^DD(+$PIECE(DD,U,2),.01,0)),U,2)'["W"
SET C="Select "_C
+5 DO PUT^DDSVALF("CAPTION",1,1,C)
+6 ;
+7 IF C0=""
Begin DoDot:2
+8 SET CC=DC
+9 SET $PIECE(DC,",",2)=$PIECE(DC,",",2)+2
+10 DO PUT^DDSVALF("CAPTION COORDINATE",1,OPG,CC)
End DoDot:2
+11 IF '$TEST
if $PIECE(CC,",")'=$PIECE(DC,",")
QUIT
+12 ;
+13 SET $PIECE(DC,",",2)=$PIECE(DC,",",2)+$LENGTH(C)-$LENGTH(C0)
+14 if $PIECE(DC,",",2)<1
SET $PIECE(DC,",",2)=1
+15 DO PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
End DoDot:1
+16 ;
+17 IF C0'="!M"
IF $PIECE(DC,",",2)-2+L>PLRC
SET L=PLRC-$PIECE(DC,",",2)+2
+18 DO PUT^DDSVALF("DATA LENGTH",1,OPG,L)
+19 QUIT
+20 ;
HBVAL ;Validate hdr blk
+1 if X=""
QUIT
if '$ORDER(@(DIE_DA_",40,""B"",X,"""")"))
QUIT
+2 SET DDSERROR=1
+3 DO HLP^DDSUTL($CHAR(7)_DDSEXT_" already exists on this page.")
+4 QUIT
+5 ;
LENGTH(DIFILE,DIFLD) ;Find max field length -NO LONGER USED!
+1 ;...
