DDSR ;SFISC/MKO-PAINT ;19DEC2015
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;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.
;
R ;All pages
;Called after wp, mults, & deletions
F DDSSC=1:1:DDSSC D RP(DDSSC(DDSSC),DDSSC=1)
Q
;
RP(X,DDS3LIN) ;Paint page
; X = DDSSC(DDSSC) node
; DDS3LIN = paint bottom line
;
S DDS3P=$P(X,U),DDS3UL=$P(X,U,2),DDS3LR=$P(X,U,3)
I DDS3UL="" W $P(DDGLCLR,DDGLDEL,2)
E D EN^DDSBOX(DDS3UL,DDS3LR)
;
;Write caps in "X" nodes
D CAP^DDSR1
;
;Paint data & exec caps
;Hdr blk
S DDS3B=$P($G(^DIST(.403,+DDS,40,DDS3P,0)),U,2)
D:DDS3B]"" DB(DDS3P,DDS3B)
;
;Other blks
S DDS3BO="" F S DDS3BO=$O(^DIST(.403,+DDS,40,DDS3P,40,"AC",DDS3BO)) Q:'DDS3BO S DDS3B=$O(^(DDS3BO,"")) Q:'DDS3B D DB(DDS3P,DDS3B)
K DDS3B,DDS3BO
;
I DDS3LIN D
. S DDSH=1,DX=0,DY=DDSHBX X IOXY W $TR($J("",IOM-1)," ","_") ;WRITE ____ LINE SO WE ARE AT LAST (80TH) COLUMN POSITION
.I DDS3UL]"" S DY=DY+1 X IOXY W $P(DDGLCLR,DDGLDEL,3) N Y F Y=DY:1:IOSL K DDSMOUSE(Y)
K DDS3P,DDS3UL,DDS3LR
Q
;
DB(DDS3P,DDS3B) ;Paint data
K @DDSREFT@("XCAP",DDS3P,DDS3B)
S DDS3=@DDSREFS@(DDS3P,DDS3B)
S DDS3FN="F"_$P(DDS3,U,3),DDS3REP=$P(DDS3,U,7),DDS3PTB=$P(DDS3,U,8)
K DDS3
;
I $G(DDS3REP)'>1 D
. N DIE
. S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B))
. S:DDS3DA]"" DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3DA,"GL"))
. S DDS3DDO=0
. F S DDS3DDO=$O(@DDSREFS@(DDS3P,DDS3B,DDS3DDO)) Q:DDS3DDO'=+DDS3DDO S DDS3C=$G(^(DDS3DDO,"D")) D:DDS3C]"" DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3PTB)
. K DDS3C,DDS3DA,DDS3DDO
E D DMULT(DDS3P,DDS3B,DDS3FN)
;
K DDS3FN,DDS3PTB,DDS3REP
Q
;
DMULT(DDS3P,DDS3B,DDS3FN) ;Paint data, all lines
N X,DIE
S DDS3PDA=$P($G(@DDSREFT@(DDS3P,DDS3B)),U)
GFT I '$D(^(DDS3B,"COMP MUL")),'DDS3PDA D
. S X="",DDS3STL=1
. S DDS3NREP=$P(@DDSREFS@(DDS3P,DDS3B),U,7),DDS3SEL=$P(^(DDS3B),U,10)
E D
. S X=@DDSREFT@(DDS3P,DDS3B,DDS3PDA)
. S DDS3STL=$P(X,U,3),DDS3NREP=$P(X,U,6),DDS3SEL=$P(X,U,9) ;3RD PIECE SAYS WHICH LINE IS NOW TOP LINE
S DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,"GL"))
;
F DDS3LN=1:1:DDS3NREP D ;PAINT LINES ONE BY ONE
. S DDS3SN=DDS3LN+DDS3STL-1
. S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
. S:DDS3LN=1 DDS3MORE=$S(DDS3STL>1:"+",1:" ") ;IF 1ST LINE ISN'T REALLY FIRST
LAST . I DDS3LN=DDS3REP S DDS3MORE=" " I $D(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2 S DDS3MORE="+",DDS3MORE("LAST")=1 ;IF LAST LINE ISN'T REALLY LAST
. D DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,.DDS3MORE,DDS3SEL)
. K DDS3MORE
;
K DDS3DA,DDS3LN,DDS3NREP,DDS3PDA,DDS3SEL,DDS3SN,DDS3STL
Q
;
DMULTN(DDS3P,DDS3B,DDS3PDA,DDS3REP,DDS3LN) ;Paint lines from DDS3LN
S DDS3FN="F"_$P(@DDSREFS@(DDS3P,DDS3B),U,3)
S DDS3STL=$P(@DDSREFT@(DDS3P,DDS3B,DDS3PDA),U,3),DDS3SEL=$P(^(DDS3PDA),U,9)
F DDS3LN=DDS3LN:1:DDS3REP D
. S DDS3SN=DDS3LN+DDS3STL-1
. S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
. S:DDS3LN=1 DDS3MORE=$S(DDS3STL>1:"+",1:" ")
. S:DDS3LN=DDS3REP DDS3MORE=$S($D(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
. D DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,.DDS3MORE,DDS3SEL)
. K DDS3MORE
K DDS3DA,DDS3FN,DDS3LN,DDS3SEL,DDS3SN,DDS3STL
Q
;
DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,DDS3MORE,DDS3SEL) ;Paint 1 line, LINE DDS3LN
N DDSHITE S DDSHITE=$$HITE(DDS3B),DDS3DDO=0
F S DDS3DDO=$O(@DDSREFS@(DDS3P,DDS3B,DDS3DDO)) Q:DDS3DDO'=+DDS3DDO S DDS3C=$G(^(DDS3DDO,"D")) I DDS3C]"" D ;go thru fields in the multiple
. S $P(DDS3C,U)=$P(DDS3C,U)+(DDS3LN-1*DDSHITE) ;DJW/GFT
. S:$P(DDS3C,U,5)]"" $P(DDS3C,U,5)=$P(DDS3C,U,5)+(DDS3LN-1*DDSHITE) ;DJW/GFT
. I $D(DDS3MORE),DDS3SEL=DDS3DDO,$P(DDS3C,U)?1.N D
.. S DY=+DDS3C,DX=$P(DDS3C,U,2)-1 Q:DX<0
PLUSSIGN .. X IOXY D
...I DDS3MORE="+" S DDSMOUSE(DY,DX,DX)=$S($D(DDS3MORE("LAST")):"NP",1:"PP") I $G(DDSMOUSY) S DDS3MORE=$$HIGH^DDSU(DDS3MORE)
...W DDS3MORE
. D DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,1,DDS3LN,DDS3SN) ;7TH parameter says ALWAYS PAINT AREA even if value is null
K DDS3C,DDS3DDO
Q
;
HITE(BLK) ;CALLED FROM DDSZ1, DDSVALF, AND MANY OTHER PLACES. TRY TO FIND THE HEIGHT (NUMBER OF ROWS) OF THE BLOCK
N D,Z,H,L,F,CAP
S D=1,H=1,L=999
F F=0:0 S F=$O(^DIST(.404,BLK,40,F)) Q:'F S Z=$G(^(F,2)) D ;Z=DATA CO-ORDINATES^LENGTH^CAPTION CO-ORDINATES, EG "3,11^66^2,2"
.S CAP=$P(Z,U,3) I 'Z S Z=CAP Q:'Z ;MIGHT BE JUST A CAPTION
.S:Z<L L=Z I CAP,CAP<Z,L=Z S L=CAP ;CAPTION MAY BE ON A LOWER LINE NUMBER THAN DATA! DEFECT 261495
.S:Z>H H=Z
.S D=H-L+1 ;GFT
Q D
;
;
DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3FLG,DDS3LN,DDS3SN) ;
;Paint field
N DDS3FLD,DDS3LEN,DDSX
D:$P(DDS3C,U,5)]"" XCAP
;
S DY=+DDS3C,DX=$P(DDS3C,U,2)
S DDS3LEN=$P(DDS3C,U,3),DDS3FLD=$P(DDS3C,U,4)
;
;Computed flds
I DDS3DA]"",$P(DDS3C,U,9) S DDSX=$$VAL^DDSCOMP(DDS3DDO,DDS3B,DDS3DA)
;
;Form only flds
Q:DDS3FLD=""
I DDS3FLD'=+DDS3FLD N DDS3FN S DDS3FN="F0"
;
;External form
S:DDS3FLD DDSX=$S(DDS3DA="":"",$D(@DDSREFT@(DDS3FN,DDS3DA,DDS3FLD,"X"))#2:^("X"),1:$G(^("D")))
PAINT D ;I $G(DDSX)]""!$G(DDS3FLG) D PAINT NULL FIELD TO SHOW COLOR
. N DDXCAP I DDS3LEN=1 D Q:$D(DDXCAP) ;GO SEE IF WE NEED PLUS SIGN IN WORD-PROCESSING BOX
..I $D(@DDSREFT@("XCAP",DDS3P)) S DDXCAP=1 Q ; EXECUTABLE CAPTION writes over "+"
..I $$WPLUS^DDSWP(DDS3FN,DDS3DA,DDS3FLD) S DDSX="+"
. S:$D(DDSX)[0 DDSX=""
. X IOXY
. I '$P(DDS3C,U,10) S DDSX=$E(DDSX,1,DDS3LEN)_$J("",DDS3LEN-$L(DDSX))
. E S DDSX=$J("",DDS3LEN-$L(DDSX))_$E(DDSX,1,DDS3LEN)
. W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10) ;I DDSX["^DIZ(600001,""C""," W "<" H 9
Q
;
;
XCAP ;Paint exec caps
N Y,DDSLN,DDSSN
I 'DDS3DA N DA,D0 S (DA,D0)=""
;
I DDS3DA N DDSDL S DDSDL=$L(DDS3DA,",")-2
I N DA,@$$D0^DDS(DDSDL)
I D BLDDA^DDS(DDS3DA)
;
S DDS3TP=$P($G(@DDSREFS@(DDS3P,DDS3B)),U,5)
S DDS3L0=$G(^DIST(.404,DDS3B,40,DDS3DDO,0)) G:DDS3L0?."^" XCAPQ
S DDS3L01=$G(^DIST(.404,DDS3B,40,DDS3DDO,.1)) G:DDS3L01?."^" XCAPQ
;
S:$D(DDS3LN) DDSLN=DDS3LN
S:$D(DDS3SN) DDSSN=DDS3SN
;
X DDS3L01 G:$G(Y)="" XCAPQ
S DDS3CAP=Y
;
I DDS3TP="e","^2^3^"[(U_$P(DDS3L0,U,3)_U)!'$P(DDS3L0,U,3) D
. S Y=$$UP^DILIBF(Y) ;**
. S @DDSREFT@("XCAP",DDS3P,Y,DDS3B,DDS3DDO)=""
;
S DY=$P(DDS3C,U,5),DX=$P(DDS3C,U,6)
S DDS3CAP=DDS3CAP_$P(DDS3C,U,7)
S:$P(DDS3C,U,8) DDS3CAP=$P(DDGLVID,DDGLDEL,4)_DDS3CAP_$P(DDGLVID,DDGLDEL,10)
X IOXY W DDS3CAP
XCAPQ K DDS3CAP,DDS3L0,DDS3L01,DDS3TP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSR 6644 printed Oct 16, 2024@18:44:03 Page 2
DDSR ;SFISC/MKO-PAINT ;19DEC2015
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+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 ;
R ;All pages
+1 ;Called after wp, mults, & deletions
+2 FOR DDSSC=1:1:DDSSC
DO RP(DDSSC(DDSSC),DDSSC=1)
+3 QUIT
+4 ;
RP(X,DDS3LIN) ;Paint page
+1 ; X = DDSSC(DDSSC) node
+2 ; DDS3LIN = paint bottom line
+3 ;
+4 SET DDS3P=$PIECE(X,U)
SET DDS3UL=$PIECE(X,U,2)
SET DDS3LR=$PIECE(X,U,3)
+5 IF DDS3UL=""
WRITE $PIECE(DDGLCLR,DDGLDEL,2)
+6 IF '$TEST
DO EN^DDSBOX(DDS3UL,DDS3LR)
+7 ;
+8 ;Write caps in "X" nodes
+9 DO CAP^DDSR1
+10 ;
+11 ;Paint data & exec caps
+12 ;Hdr blk
+13 SET DDS3B=$PIECE($GET(^DIST(.403,+DDS,40,DDS3P,0)),U,2)
+14 if DDS3B]""
DO DB(DDS3P,DDS3B)
+15 ;
+16 ;Other blks
+17 SET DDS3BO=""
FOR
SET DDS3BO=$ORDER(^DIST(.403,+DDS,40,DDS3P,40,"AC",DDS3BO))
if 'DDS3BO
QUIT
SET DDS3B=$ORDER(^(DDS3BO,""))
if 'DDS3B
QUIT
DO DB(DDS3P,DDS3B)
+18 KILL DDS3B,DDS3BO
+19 ;
+20 IF DDS3LIN
Begin DoDot:1
+21 ;WRITE ____ LINE SO WE ARE AT LAST (80TH) COLUMN POSITION
SET DDSH=1
SET DX=0
SET DY=DDSHBX
XECUTE IOXY
WRITE $TRANSLATE($JUSTIFY("",IOM-1)," ","_")
+22 IF DDS3UL]""
SET DY=DY+1
XECUTE IOXY
WRITE $PIECE(DDGLCLR,DDGLDEL,3)
NEW Y
FOR Y=DY:1:IOSL
KILL DDSMOUSE(Y)
End DoDot:1
+23 KILL DDS3P,DDS3UL,DDS3LR
+24 QUIT
+25 ;
DB(DDS3P,DDS3B) ;Paint data
+1 KILL @DDSREFT@("XCAP",DDS3P,DDS3B)
+2 SET DDS3=@DDSREFS@(DDS3P,DDS3B)
+3 SET DDS3FN="F"_$PIECE(DDS3,U,3)
SET DDS3REP=$PIECE(DDS3,U,7)
SET DDS3PTB=$PIECE(DDS3,U,8)
+4 KILL DDS3
+5 ;
+6 IF $GET(DDS3REP)'>1
Begin DoDot:1
+7 NEW DIE
+8 SET DDS3DA=$GET(@DDSREFT@(DDS3P,DDS3B))
+9 if DDS3DA]""
SET DIE=$GET(@DDSREFT@(DDS3P,DDS3B,DDS3DA,"GL"))
+10 SET DDS3DDO=0
+11 FOR
SET DDS3DDO=$ORDER(@DDSREFS@(DDS3P,DDS3B,DDS3DDO))
if DDS3DDO'=+DDS3DDO
QUIT
SET DDS3C=$GET(^(DDS3DDO,"D"))
if DDS3C]""
DO DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3PTB)
+12 KILL DDS3C,DDS3DA,DDS3DDO
End DoDot:1
+13 IF '$TEST
DO DMULT(DDS3P,DDS3B,DDS3FN)
+14 ;
+15 KILL DDS3FN,DDS3PTB,DDS3REP
+16 QUIT
+17 ;
DMULT(DDS3P,DDS3B,DDS3FN) ;Paint data, all lines
+1 NEW X,DIE
+2 SET DDS3PDA=$PIECE($GET(@DDSREFT@(DDS3P,DDS3B)),U)
GFT IF '$DATA(^(DDS3B,"COMP MUL"))
IF 'DDS3PDA
Begin DoDot:1
+1 SET X=""
SET DDS3STL=1
+2 SET DDS3NREP=$PIECE(@DDSREFS@(DDS3P,DDS3B),U,7)
SET DDS3SEL=$PIECE(^(DDS3B),U,10)
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET X=@DDSREFT@(DDS3P,DDS3B,DDS3PDA)
+5 ;3RD PIECE SAYS WHICH LINE IS NOW TOP LINE
SET DDS3STL=$PIECE(X,U,3)
SET DDS3NREP=$PIECE(X,U,6)
SET DDS3SEL=$PIECE(X,U,9)
End DoDot:1
+6 SET DIE=$GET(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,"GL"))
+7 ;
+8 ;PAINT LINES ONE BY ONE
FOR DDS3LN=1:1:DDS3NREP
Begin DoDot:1
+9 SET DDS3SN=DDS3LN+DDS3STL-1
+10 SET DDS3DA=$GET(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
+11 ;IF 1ST LINE ISN'T REALLY FIRST
if DDS3LN=1
SET DDS3MORE=$SELECT(DDS3STL>1:"+",1:" ")
LAST ;IF LAST LINE ISN'T REALLY LAST
IF DDS3LN=DDS3REP
SET DDS3MORE=" "
IF $DATA(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2
SET DDS3MORE="+"
SET DDS3MORE("LAST")=1
+1 DO DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,.DDS3MORE,DDS3SEL)
+2 KILL DDS3MORE
End DoDot:1
+3 ;
+4 KILL DDS3DA,DDS3LN,DDS3NREP,DDS3PDA,DDS3SEL,DDS3SN,DDS3STL
+5 QUIT
+6 ;
DMULTN(DDS3P,DDS3B,DDS3PDA,DDS3REP,DDS3LN) ;Paint lines from DDS3LN
+1 SET DDS3FN="F"_$PIECE(@DDSREFS@(DDS3P,DDS3B),U,3)
+2 SET DDS3STL=$PIECE(@DDSREFT@(DDS3P,DDS3B,DDS3PDA),U,3)
SET DDS3SEL=$PIECE(^(DDS3PDA),U,9)
+3 FOR DDS3LN=DDS3LN:1:DDS3REP
Begin DoDot:1
+4 SET DDS3SN=DDS3LN+DDS3STL-1
+5 SET DDS3DA=$GET(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
+6 if DDS3LN=1
SET DDS3MORE=$SELECT(DDS3STL>1:"+",1:" ")
+7 if DDS3LN=DDS3REP
SET DDS3MORE=$SELECT($DATA(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
+8 DO DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,.DDS3MORE,DDS3SEL)
+9 KILL DDS3MORE
End DoDot:1
+10 KILL DDS3DA,DDS3FN,DDS3LN,DDS3SEL,DDS3SN,DDS3STL
+11 QUIT
+12 ;
DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,DDS3MORE,DDS3SEL) ;Paint 1 line, LINE DDS3LN
+1 NEW DDSHITE
SET DDSHITE=$$HITE(DDS3B)
SET DDS3DDO=0
+2 ;go thru fields in the multiple
FOR
SET DDS3DDO=$ORDER(@DDSREFS@(DDS3P,DDS3B,DDS3DDO))
if DDS3DDO'=+DDS3DDO
QUIT
SET DDS3C=$GET(^(DDS3DDO,"D"))
IF DDS3C]""
Begin DoDot:1
+3 ;DJW/GFT
SET $PIECE(DDS3C,U)=$PIECE(DDS3C,U)+(DDS3LN-1*DDSHITE)
+4 ;DJW/GFT
if $PIECE(DDS3C,U,5)]""
SET $PIECE(DDS3C,U,5)=$PIECE(DDS3C,U,5)+(DDS3LN-1*DDSHITE)
+5 IF $DATA(DDS3MORE)
IF DDS3SEL=DDS3DDO
IF $PIECE(DDS3C,U)?1.N
Begin DoDot:2
+6 SET DY=+DDS3C
SET DX=$PIECE(DDS3C,U,2)-1
if DX<0
QUIT
PLUSSIGN XECUTE IOXY
Begin DoDot:3
+1 IF DDS3MORE="+"
SET DDSMOUSE(DY,DX,DX)=$SELECT($DATA(DDS3MORE("LAST")):"NP",1:"PP")
IF $GET(DDSMOUSY)
SET DDS3MORE=$$HIGH^DDSU(DDS3MORE)
+2 WRITE DDS3MORE
End DoDot:3
End DoDot:2
+3 ;7TH parameter says ALWAYS PAINT AREA even if value is null
DO DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,1,DDS3LN,DDS3SN)
End DoDot:1
+4 KILL DDS3C,DDS3DDO
+5 QUIT
+6 ;
HITE(BLK) ;CALLED FROM DDSZ1, DDSVALF, AND MANY OTHER PLACES. TRY TO FIND THE HEIGHT (NUMBER OF ROWS) OF THE BLOCK
+1 NEW D,Z,H,L,F,CAP
+2 SET D=1
SET H=1
SET L=999
+3 ;Z=DATA CO-ORDINATES^LENGTH^CAPTION CO-ORDINATES, EG "3,11^66^2,2"
FOR F=0:0
SET F=$ORDER(^DIST(.404,BLK,40,F))
if 'F
QUIT
SET Z=$GET(^(F,2))
Begin DoDot:1
+4 ;MIGHT BE JUST A CAPTION
SET CAP=$PIECE(Z,U,3)
IF 'Z
SET Z=CAP
if 'Z
QUIT
+5 ;CAPTION MAY BE ON A LOWER LINE NUMBER THAN DATA! DEFECT 261495
if Z<L
SET L=Z
IF CAP
IF CAP<Z
IF L=Z
SET L=CAP
+6 if Z>H
SET H=Z
+7 ;GFT
SET D=H-L+1
End DoDot:1
+8 QUIT D
+9 ;
+10 ;
DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3FLG,DDS3LN,DDS3SN) ;
+1 ;Paint field
+2 NEW DDS3FLD,DDS3LEN,DDSX
+3 if $PIECE(DDS3C,U,5)]""
DO XCAP
+4 ;
+5 SET DY=+DDS3C
SET DX=$PIECE(DDS3C,U,2)
+6 SET DDS3LEN=$PIECE(DDS3C,U,3)
SET DDS3FLD=$PIECE(DDS3C,U,4)
+7 ;
+8 ;Computed flds
+9 IF DDS3DA]""
IF $PIECE(DDS3C,U,9)
SET DDSX=$$VAL^DDSCOMP(DDS3DDO,DDS3B,DDS3DA)
+10 ;
+11 ;Form only flds
+12 if DDS3FLD=""
QUIT
+13 IF DDS3FLD'=+DDS3FLD
NEW DDS3FN
SET DDS3FN="F0"
+14 ;
+15 ;External form
+16 if DDS3FLD
SET DDSX=$SELECT(DDS3DA="":"",$DATA(@DDSREFT@(DDS3FN,DDS3DA,DDS3FLD,"X"))#2:^("X"),1:$GET(^("D")))
PAINT ;I $G(DDSX)]""!$G(DDS3FLG) D PAINT NULL FIELD TO SHOW COLOR
Begin DoDot:1
+1 ;GO SEE IF WE NEED PLUS SIGN IN WORD-PROCESSING BOX
NEW DDXCAP
IF DDS3LEN=1
Begin DoDot:2
+2 ; EXECUTABLE CAPTION writes over "+"
IF $DATA(@DDSREFT@("XCAP",DDS3P))
SET DDXCAP=1
QUIT
+3 IF $$WPLUS^DDSWP(DDS3FN,DDS3DA,DDS3FLD)
SET DDSX="+"
End DoDot:2
if $DATA(DDXCAP)
QUIT
+4 if $DATA(DDSX)[0
SET DDSX=""
+5 XECUTE IOXY
+6 IF '$PIECE(DDS3C,U,10)
SET DDSX=$EXTRACT(DDSX,1,DDS3LEN)_$JUSTIFY("",DDS3LEN-$LENGTH(DDSX))
+7 IF '$TEST
SET DDSX=$JUSTIFY("",DDS3LEN-$LENGTH(DDSX))_$EXTRACT(DDSX,1,DDS3LEN)
+8 ;I DDSX["^DIZ(600001,""C""," W "<" H 9
WRITE $PIECE(DDGLVID,DDGLDEL)_DDSX_$PIECE(DDGLVID,DDGLDEL,10)
End DoDot:1
+9 QUIT
+10 ;
+11 ;
XCAP ;Paint exec caps
+1 NEW Y,DDSLN,DDSSN
+2 IF 'DDS3DA
NEW DA,D0
SET (DA,D0)=""
+3 ;
+4 IF DDS3DA
NEW DDSDL
SET DDSDL=$LENGTH(DDS3DA,",")-2
+5 IF $TEST
NEW DA,@$$D0^DDS(DDSDL)
+6 IF $TEST
DO BLDDA^DDS(DDS3DA)
+7 ;
+8 SET DDS3TP=$PIECE($GET(@DDSREFS@(DDS3P,DDS3B)),U,5)
+9 SET DDS3L0=$GET(^DIST(.404,DDS3B,40,DDS3DDO,0))
if DDS3L0?."^"
GOTO XCAPQ
+10 SET DDS3L01=$GET(^DIST(.404,DDS3B,40,DDS3DDO,.1))
if DDS3L01?."^"
GOTO XCAPQ
+11 ;
+12 if $DATA(DDS3LN)
SET DDSLN=DDS3LN
+13 if $DATA(DDS3SN)
SET DDSSN=DDS3SN
+14 ;
+15 XECUTE DDS3L01
if $GET(Y)=""
GOTO XCAPQ
+16 SET DDS3CAP=Y
+17 ;
+18 IF DDS3TP="e"
IF "^2^3^"[(U_$PIECE(DDS3L0,U,3)_U)!'$PIECE(DDS3L0,U,3)
Begin DoDot:1
+19 ;**
SET Y=$$UP^DILIBF(Y)
+20 SET @DDSREFT@("XCAP",DDS3P,Y,DDS3B,DDS3DDO)=""
End DoDot:1
+21 ;
+22 SET DY=$PIECE(DDS3C,U,5)
SET DX=$PIECE(DDS3C,U,6)
+23 SET DDS3CAP=DDS3CAP_$PIECE(DDS3C,U,7)
+24 if $PIECE(DDS3C,U,8)
SET DDS3CAP=$PIECE(DDGLVID,DDGLDEL,4)_DDS3CAP_$PIECE(DDGLVID,DDGLDEL,10)
+25 XECUTE IOXY
WRITE DDS3CAP
XCAPQ KILL DDS3CAP,DDS3L0,DDS3L01,DDS3TP
+1 QUIT
