- 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