- DDGFFLD ;SFISC/MKO - EDIT A FIELD ;19APR2016
- ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
- ;;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.
- ;GFT;**1055**
- ;
- ;COME IN WITH 'F'=FIELD NUMBER ON BLOCK 'B', PAGE DDGFWID="P4"
- ;
- EDIT ;
- Q:$D(^DIST(.404,B,40,F,0))[0
- I T="D" Q:C]"" K @DDGFREF@("F",DDGFPG,B,F)
- ;
- S DDGFDY=DY,DDGFDX=DX
- S DDGFTYPE=$P(^DIST(.404,B,40,F,0),U,3)
- I 'DDGFTYPE D
- . I $G(^DIST(.404,B,40,F,20))'?."^" S DDGFTYPE=2 Q
- . I $P($G(^DIST(.404,B,0)),U,2),$G(^DIST(.404,B,40,F,1)) S DDGFTYPE=3
- G:'DDGFTYPE EDITQ
- ;
- S DDGFB2=@DDGFREF@("F",DDGFPG,B)
- S DDGFB1=$P(DDGFB2,U),DDGFB2=$P(DDGFB2,U,2)
- S DDGFDD=$P(^DIST(.404,B,0),U,2)
- S (DDGFSUP,DDGFSUP0)=$S(C]""&(DDGFTYPE'=1):$E(C,$L(C))'=":",1:"")
- S (DDGFCAP,DDGFCAP0)=$S(DDGFTYPE=1!DDGFSUP0:C,1:$E(C,1,$L(C)-1))
- S (DDGFCC,DDGFCC0)=$S(C]"":C1-DDGFB1+1_","_(C2-DDGFB2+1),1:"")
- I $D(D) D
- . S (DDGFDL,DDGFDL0)=L
- . S (DDGFDC,DDGFDC0)=D1-DDGFB1+1_","_(D2-DDGFB2+1)
- K DDGFB1,DDGFB2
- ;
- S DDSFILE=.404,DDSFILE(1)=.4044,DDSPARM="KSTW"
- S DR="[DDGF FIELD "_$P("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
- S DA=F,DA(1)=B
- D
- . N B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
- DDS . D ^DDS K DDSFILE,DDSPARM,DR,DDGFDD ;RECURSIVE CALL TO SCREENMAN FOR A GIVEN FIELD
- ;
- ;If caption, caption coords, data length, data coords, or suppress
- ;colon flag changed we need to update some local variables
- I '$D(DA) D KILLPGS^DDGFFLDA(B,DDGFWID) ;FIELD IS GONE
- I $D(DA)#2,$G(DDSSAVE) D ;BECAUSE DDSPARM CONTAINED "S", DDSSAVE CAN COME BACK FROM ^DDS
- . S DDGFNDB=$G(@DDGFREF@("F",DDGFPG,B))
- . S:DDGFCAP="" (DDGFSUP,DDGFCC)=""
- . S DR=""
- . ;
- . I DDGFCAP'=DDGFCAP0!(DDGFSUP'=DDGFSUP0) D ;CAPTION HAS BEEN CHANGED
- .. S C=DDGFCAP_$S(DDGFCAP]""&(DDGFTYPE'=1)&'DDGFSUP:":",1:"")
- .. S:DDGFCAP'=DDGFCAP0 DR=DR_"1////"_$S(DDGFCAP]"":DDGFCAP,1:"@")_";"
- .. S:DDGFSUP'=DDGFSUP0 DR=DR_"5.2////"_$S(DDGFSUP:1,1:"@")_";"
- . ;
- . D:DDGFCC'=DDGFCC0 ;LOCATION OF CAPTION HAS BEEN CHANGED
- .. S C1=$S(DDGFCAP]"":$P(DDGFCC,",")-1+$P(DDGFNDB,U),1:"")
- .. S C2=$S(DDGFCAP]"":$P(DDGFCC,",",2)-1+$P(DDGFNDB,U,2),1:"")
- .. S DR=DR_"5.1////"_$S(DDGFCC]"":DDGFCC,1:"@")_";"
- . ;
- . D:$D(D)
- .. D:DDGFDC'=DDGFDC0
- ... S D1=$P(DDGFDC,",")-1+$P(DDGFNDB,U)
- ... S D2=$P(DDGFDC,",",2)-1+$P(DDGFNDB,U,2)
- ... S DR=DR_"4.1////"_DDGFDC_";"
- .. D:DDGFDL'=DDGFDL0
- ... S L=DDGFDL
- ... S D=$TR($J("",L)," ","_")
- ... S DR=DR_"4.2////"_DDGFDL_";"
- . ;
- . I T="D",C]"" D
- .. D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2,"",1)
- .. S @DDGFREF@("RC",DDGFWID,C1,C2,C2+$L(C)-1,B,F,"C")=""
- . ;
- . I DR]"" D D KILLPGS^DDGFFLDA(B,DDGFWID) ;SOMETHING'S CHANGED, SO ERASE OTHER PAGES CONTAINING THIS BLOCK
- .. N B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
- .. S DIE="^DIST(.404,"_DA(1)_",40,"
- .. S DR=$E(DR,1,$L(DR)-1)
- .. D ^DIE
- ;
- K DA,DDGFNDB
- K DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
- K DDGFDL,DDGFDL0,DDGFDC,DDGFDC0,DDSSAVE
- K DIE,DR
- ;
- D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
- EDITQ S DDGFE=1
- K DDGFDY,DDGFDX,DDGFTYPE
- Q
- ;
- RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
- N S
- I DDGFR D
- . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
- . X IOXY W S_$J("",7-$L(S))
- S DY=DDGFY,DX=DDGFX X IOXY
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFFLD 3425 printed Mar 13, 2025@21:47:06 Page 2
- DDGFFLD ;SFISC/MKO - EDIT A FIELD ;19APR2016
- +1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
- +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 ;GFT;**1055**
- +7 ;
- +8 ;COME IN WITH 'F'=FIELD NUMBER ON BLOCK 'B', PAGE DDGFWID="P4"
- +9 ;
- EDIT ;
- +1 if $DATA(^DIST(.404,B,40,F,0))[0
- QUIT
- +2 IF T="D"
- if C]""
- QUIT
- KILL @DDGFREF@("F",DDGFPG,B,F)
- +3 ;
- +4 SET DDGFDY=DY
- SET DDGFDX=DX
- +5 SET DDGFTYPE=$PIECE(^DIST(.404,B,40,F,0),U,3)
- +6 IF 'DDGFTYPE
- Begin DoDot:1
- +7 IF $GET(^DIST(.404,B,40,F,20))'?."^"
- SET DDGFTYPE=2
- QUIT
- +8 IF $PIECE($GET(^DIST(.404,B,0)),U,2)
- IF $GET(^DIST(.404,B,40,F,1))
- SET DDGFTYPE=3
- End DoDot:1
- +9 if 'DDGFTYPE
- GOTO EDITQ
- +10 ;
- +11 SET DDGFB2=@DDGFREF@("F",DDGFPG,B)
- +12 SET DDGFB1=$PIECE(DDGFB2,U)
- SET DDGFB2=$PIECE(DDGFB2,U,2)
- +13 SET DDGFDD=$PIECE(^DIST(.404,B,0),U,2)
- +14 SET (DDGFSUP,DDGFSUP0)=$SELECT(C]""&(DDGFTYPE'=1):$EXTRACT(C,$LENGTH(C))'=":",1:"")
- +15 SET (DDGFCAP,DDGFCAP0)=$SELECT(DDGFTYPE=1!DDGFSUP0:C,1:$EXTRACT(C,1,$LENGTH(C)-1))
- +16 SET (DDGFCC,DDGFCC0)=$SELECT(C]"":C1-DDGFB1+1_","_(C2-DDGFB2+1),1:"")
- +17 IF $DATA(D)
- Begin DoDot:1
- +18 SET (DDGFDL,DDGFDL0)=L
- +19 SET (DDGFDC,DDGFDC0)=D1-DDGFB1+1_","_(D2-DDGFB2+1)
- End DoDot:1
- +20 KILL DDGFB1,DDGFB2
- +21 ;
- +22 SET DDSFILE=.404
- SET DDSFILE(1)=.4044
- SET DDSPARM="KSTW"
- +23 SET DR="[DDGF FIELD "_$PIECE("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
- +24 SET DA=F
- SET DA(1)=B
- +25 Begin DoDot:1
- +26 NEW B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
- DDS ;RECURSIVE CALL TO SCREENMAN FOR A GIVEN FIELD
- DO ^DDS
- KILL DDSFILE,DDSPARM,DR,DDGFDD
- End DoDot:1
- +1 ;
- +2 ;If caption, caption coords, data length, data coords, or suppress
- +3 ;colon flag changed we need to update some local variables
- +4 ;FIELD IS GONE
- IF '$DATA(DA)
- DO KILLPGS^DDGFFLDA(B,DDGFWID)
- +5 ;BECAUSE DDSPARM CONTAINED "S", DDSSAVE CAN COME BACK FROM ^DDS
- IF $DATA(DA)#2
- IF $GET(DDSSAVE)
- Begin DoDot:1
- +6 SET DDGFNDB=$GET(@DDGFREF@("F",DDGFPG,B))
- +7 if DDGFCAP=""
- SET (DDGFSUP,DDGFCC)=""
- +8 SET DR=""
- +9 ;
- +10 ;CAPTION HAS BEEN CHANGED
- IF DDGFCAP'=DDGFCAP0!(DDGFSUP'=DDGFSUP0)
- Begin DoDot:2
- +11 SET C=DDGFCAP_$SELECT(DDGFCAP]""&(DDGFTYPE'=1)&'DDGFSUP:":",1:"")
- +12 if DDGFCAP'=DDGFCAP0
- SET DR=DR_"1////"_$SELECT(DDGFCAP]"":DDGFCAP,1:"@")_";"
- +13 if DDGFSUP'=DDGFSUP0
- SET DR=DR_"5.2////"_$SELECT(DDGFSUP:1,1:"@")_";"
- End DoDot:2
- +14 ;
- +15 ;LOCATION OF CAPTION HAS BEEN CHANGED
- if DDGFCC'=DDGFCC0
- Begin DoDot:2
- +16 SET C1=$SELECT(DDGFCAP]"":$PIECE(DDGFCC,",")-1+$PIECE(DDGFNDB,U),1:"")
- +17 SET C2=$SELECT(DDGFCAP]"":$PIECE(DDGFCC,",",2)-1+$PIECE(DDGFNDB,U,2),1:"")
- +18 SET DR=DR_"5.1////"_$SELECT(DDGFCC]"":DDGFCC,1:"@")_";"
- End DoDot:2
- +19 ;
- +20 if $DATA(D)
- Begin DoDot:2
- +21 if DDGFDC'=DDGFDC0
- Begin DoDot:3
- +22 SET D1=$PIECE(DDGFDC,",")-1+$PIECE(DDGFNDB,U)
- +23 SET D2=$PIECE(DDGFDC,",",2)-1+$PIECE(DDGFNDB,U,2)
- +24 SET DR=DR_"4.1////"_DDGFDC_";"
- End DoDot:3
- +25 if DDGFDL'=DDGFDL0
- Begin DoDot:3
- +26 SET L=DDGFDL
- +27 SET D=$TRANSLATE($JUSTIFY("",L)," ","_")
- +28 SET DR=DR_"4.2////"_DDGFDL_";"
- End DoDot:3
- End DoDot:2
- +29 ;
- +30 IF T="D"
- IF C]""
- Begin DoDot:2
- +31 DO WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2,"",1)
- +32 SET @DDGFREF@("RC",DDGFWID,C1,C2,C2+$LENGTH(C)-1,B,F,"C")=""
- End DoDot:2
- +33 ;
- +34 ;SOMETHING'S CHANGED, SO ERASE OTHER PAGES CONTAINING THIS BLOCK
- IF DR]""
- Begin DoDot:2
- +35 NEW B,F,T,C,C1,C2,D,D1,D2,L,P1,P2
- +36 SET DIE="^DIST(.404,"_DA(1)_",40,"
- +37 SET DR=$EXTRACT(DR,1,$LENGTH(DR)-1)
- +38 DO ^DIE
- End DoDot:2
- DO KILLPGS^DDGFFLDA(B,DDGFWID)
- End DoDot:1
- +39 ;
- +40 KILL DA,DDGFNDB
- +41 KILL DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
- +42 KILL DDGFDL,DDGFDL0,DDGFDC,DDGFDC0,DDSSAVE
- +43 KILL DIE,DR
- +44 ;
- +45 DO REFRESH^DDGF
- DO RC(DDGFDY,DDGFDX)
- EDITQ SET DDGFE=1
- +1 KILL DDGFDY,DDGFDX,DDGFTYPE
- +2 QUIT
- +3 ;
- RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
- +1 NEW S
- +2 IF DDGFR
- Begin DoDot:1
- +3 SET DY=IOSL-6
- SET DX=IOM-9
- SET S="R"_(DDGFY+1)_",C"_(DDGFX+1)
- +4 XECUTE IOXY
- WRITE S_$JUSTIFY("",7-$LENGTH(S))
- End DoDot:1
- +5 SET DY=DDGFY
- SET DX=DDGFX
- XECUTE IOXY
- +6 QUIT
