DDSR ;SFISC/MKO-PAINT ;3:11 PM 11 Jun 1996
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
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 ^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)," ","_")
. I DDS3UL]"" S DY=DY+1 X IOXY W $P(DDGLCLR,DDGLDEL,3)
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)
I '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)
S DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,"GL"))
;
F DDS3LN=1:1:DDS3NREP 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,$G(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,$G(DDS3MORE),DDS3SEL)
. K DDS3MORE
K DDS3DA,DDS3FN,DDS3LN,DDS3SEL,DDS3SN,DDS3STL
Q
;
DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,DDS3MORE,DDS3SEL) ;Paint 1 line
S DDS3DDO=0
F S DDS3DDO=$O(@DDSREFS@(DDS3P,DDS3B,DDS3DDO)) Q:DDS3DDO'=+DDS3DDO S DDS3C=$G(^(DDS3DDO,"D")) I DDS3C]"" D
. S $P(DDS3C,U)=$P(DDS3C,U)+DDS3LN-1
. S:$P(DDS3C,U,5)]"" $P(DDS3C,U,5)=$P(DDS3C,U,5)+DDS3LN-1
. I $D(DDS3MORE),DDS3SEL=DDS3DDO,$P(DDS3C,U) D
.. S DY=+DDS3C,DX=$P(DDS3C,U,2)-1 Q:DX<0
.. X IOXY W DDS3MORE
. D DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,1,DDS3LN,DDS3SN)
K DDS3C,DDS3DDO
Q
;
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")))
I $G(DDSX)]""!$G(DDS3FLG) D
. 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)
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=$TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. 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
DDSR ;SFISC/MKO-PAINT ;3:11 PM 11 Jun 1996
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
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 ^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 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)
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)
+3 IF 'DDS3PDA
Begin DoDot:1
+4 SET X=""
SET DDS3STL=1
+5 SET DDS3NREP=$PIECE(@DDSREFS@(DDS3P,DDS3B),U,7)
SET DDS3SEL=$PIECE(^(DDS3B),U,10)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET X=@DDSREFT@(DDS3P,DDS3B,DDS3PDA)
+8 SET DDS3STL=$PIECE(X,U,3)
SET DDS3NREP=$PIECE(X,U,6)
SET DDS3SEL=$PIECE(X,U,9)
End DoDot:1
+9 SET DIE=$GET(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,"GL"))
+10 ;
+11 FOR DDS3LN=1:1:DDS3NREP
Begin DoDot:1
+12 SET DDS3SN=DDS3LN+DDS3STL-1
+13 SET DDS3DA=$GET(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
+14 IF DDS3LN=1
SET DDS3MORE=$SELECT(DDS3STL>1:"+",1:" ")
+15 IF DDS3LN=DDS3REP
SET DDS3MORE=$SELECT($DATA(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
+16 DO DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,$GET(DDS3MORE),DDS3SEL)
+17 KILL DDS3MORE
End DoDot:1
+18 ;
+19 KILL DDS3DA,DDS3LN,DDS3NREP,DDS3PDA,DDS3SEL,DDS3SN,DDS3STL
+20 QUIT
+21 ;
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,$GET(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
+1 SET DDS3DDO=0
+2 FOR
SET DDS3DDO=$ORDER(@DDSREFS@(DDS3P,DDS3B,DDS3DDO))
IF DDS3DDO'=+DDS3DDO
QUIT
SET DDS3C=$GET(^(DDS3DDO,"D"))
IF DDS3C]""
Begin DoDot:1
+3 SET $PIECE(DDS3C,U)=$PIECE(DDS3C,U)+DDS3LN-1
+4 IF $PIECE(DDS3C,U,5)]""
SET $PIECE(DDS3C,U,5)=$PIECE(DDS3C,U,5)+DDS3LN-1
+5 IF $DATA(DDS3MORE)
IF DDS3SEL=DDS3DDO
IF $PIECE(DDS3C,U)
Begin DoDot:2
+6 SET DY=+DDS3C
SET DX=$PIECE(DDS3C,U,2)-1
IF DX<0
QUIT
+7 XECUTE IOXY
WRITE DDS3MORE
End DoDot:2
+8 DO DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,1,DDS3LN,DDS3SN)
End DoDot:1
+9 KILL DDS3C,DDS3DDO
+10 QUIT
+11 ;
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")))
+17 IF $GET(DDSX)]""!$GET(DDS3FLG)
Begin DoDot:1
+18 IF $DATA(DDSX)[0
SET DDSX=""
+19 XECUTE IOXY
+20 IF '$PIECE(DDS3C,U,10)
SET DDSX=$EXTRACT(DDSX,1,DDS3LEN)_$JUSTIFY("",DDS3LEN-$LENGTH(DDSX))
+21 IF '$TEST
SET DDSX=$JUSTIFY("",DDS3LEN-$LENGTH(DDSX))_$EXTRACT(DDSX,1,DDS3LEN)
+22 WRITE $PIECE(DDGLVID,DDGLDEL)_DDSX_$PIECE(DDGLVID,DDGLDEL,10)
End DoDot:1
+23 QUIT
+24 ;
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=$TRANSLATE(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+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
