Annotation of freem_fileman/DDSR.m, revision 1.1
1.1 ! snw 1: DDSR ;SFISC/MKO-PAINT ;01:20 PM 21 Dec 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: R ;All pages
! 5: ;Called after wp, mults, & deletions
! 6: F DDSSC=1:1:DDSSC D RP(DDSSC(DDSSC),DDSSC=1)
! 7: Q
! 8: ;
! 9: RP(X,DDS3LIN) ;Paint page
! 10: ; X = DDSSC(DDSSC) node
! 11: ; DDS3LIN = paint bottom line
! 12: ;
! 13: S DDS3P=$P(X,U),DDS3UL=$P(X,U,2),DDS3LR=$P(X,U,3)
! 14: I DDS3UL="" W $P(DDGLCLR,DDGLDEL,2)
! 15: E D ^DDSBOX(DDS3UL,DDS3LR)
! 16: ;
! 17: ;Write caps in "X" nodes
! 18: D CAP^DDSR1
! 19: ;
! 20: ;Paint data & exec caps
! 21: ;Hdr blk
! 22: S DDS3B=$P($G(^DIST(.403,+DDS,40,DDS3P,0)),U,2)
! 23: D:DDS3B]"" DB(DDS3P,DDS3B)
! 24: ;
! 25: ;Other blks
! 26: 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)
! 27: K DDS3B,DDS3BO
! 28: ;
! 29: I DDS3LIN D
! 30: . S DDSH=1,DX=0,DY=DDSHBX X IOXY W $TR($J("",IOM-1)," ","_")
! 31: . I DDS3UL]"" S DY=DY+1 X IOXY W $P(DDGLCLR,DDGLDEL,3)
! 32: K DDS3P,DDS3UL,DDS3LR
! 33: Q
! 34: ;
! 35: DB(DDS3P,DDS3B) ;Paint data
! 36: K @DDSREFT@("XCAP",DDS3P,DDS3B)
! 37: S DDS3=@DDSREFS@(DDS3P,DDS3B)
! 38: S DDS3FN="F"_$P(DDS3,U,3),DDS3REP=$P(DDS3,U,7),DDS3PTB=$P(DDS3,U,8)
! 39: K DDS3
! 40: ;
! 41: I $G(DDS3REP)'>1 D
! 42: . N DIE
! 43: . S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B))
! 44: . S:DDS3DA]"" DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3DA,"GL"))
! 45: . S DDS3DDO=0
! 46: . 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)
! 47: . K DDS3C,DDS3DA,DDS3DDO
! 48: E D DMULT(DDS3P,DDS3B,DDS3FN)
! 49: ;
! 50: K DDS3FN,DDS3PTB,DDS3REP
! 51: Q
! 52: ;
! 53: DMULT(DDS3P,DDS3B,DDS3FN) ;Paint data, all lines
! 54: N X,DIE
! 55: S DDS3PDA=$P(@DDSREFT@(DDS3P,DDS3B),U) Q:DDS3PDA=""
! 56: S X=@DDSREFT@(DDS3P,DDS3B,DDS3PDA)
! 57: S DDS3STL=$P(X,U,3),DDS3NREP=$P(X,U,6),DDS3SEL=$P(X,U,9)
! 58: S DIE=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,"GL"))
! 59: ;
! 60: F DDS3LN=1:1:DDS3NREP D
! 61: . S DDS3SN=DDS3LN+DDS3STL-1
! 62: . S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
! 63: . S:DDS3LN=1 DDS3MORE=$S(DDS3STL>1:"+",1:" ")
! 64: . S:DDS3LN=DDS3REP DDS3MORE=$S($D(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
! 65: . D DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,$G(DDS3MORE),DDS3SEL)
! 66: . K DDS3MORE
! 67: ;
! 68: K DDS3DA,DDS3LN,DDS3NREP,DDS3PDA,DDS3SEL,DDS3SN,DDS3STL
! 69: Q
! 70: ;
! 71: DMULTN(DDS3P,DDS3B,DDS3PDA,DDS3REP,DDS3LN) ;Paint lines from DDS3LN
! 72: S DDS3FN="F"_$P(@DDSREFS@(DDS3P,DDS3B),U,3)
! 73: S DDS3STL=$P(@DDSREFT@(DDS3P,DDS3B,DDS3PDA),U,3),DDS3SEL=$P(^(DDS3PDA),U,9)
! 74: F DDS3LN=DDS3LN:1:DDS3REP D
! 75: . S DDS3SN=DDS3LN+DDS3STL-1
! 76: . S DDS3DA=$G(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN))
! 77: . S:DDS3LN=1 DDS3MORE=$S(DDS3STL>1:"+",1:" ")
! 78: . S:DDS3LN=DDS3REP DDS3MORE=$S($D(@DDSREFT@(DDS3P,DDS3B,DDS3PDA,DDS3SN+1))#2:"+",1:" ")
! 79: . D DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,$G(DDS3MORE),DDS3SEL)
! 80: . K DDS3MORE
! 81: K DDS3DA,DDS3FN,DDS3LN,DDS3SEL,DDS3SN,DDS3STL
! 82: Q
! 83: ;
! 84: DMULT1(DDS3P,DDS3B,DDS3FN,DDS3DA,DDS3LN,DDS3SN,DDS3MORE,DDS3SEL) ;Paint 1 line
! 85: S DDS3DDO=0
! 86: F S DDS3DDO=$O(@DDSREFS@(DDS3P,DDS3B,DDS3DDO)) Q:DDS3DDO'=+DDS3DDO S DDS3C=$G(^(DDS3DDO,"D")) I DDS3C]"" D
! 87: . S $P(DDS3C,U)=$P(DDS3C,U)+DDS3LN-1
! 88: . S:$P(DDS3C,U,5)]"" $P(DDS3C,U,5)=$P(DDS3C,U,5)+DDS3LN-1
! 89: . I $D(DDS3MORE),DDS3SEL=DDS3DDO,$P(DDS3C,U) D
! 90: .. S DY=+DDS3C,DX=$P(DDS3C,U,2)-1 Q:DX<0
! 91: .. X IOXY W DDS3MORE
! 92: . D DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,1,DDS3LN,DDS3SN)
! 93: K DDS3C,DDS3DDO
! 94: Q
! 95: ;
! 96: DF(DDS3P,DDS3B,DDS3DDO,DDS3DA,DDS3C,DDS3FN,DDS3FLG,DDS3LN,DDS3SN) ;
! 97: ;Paint field
! 98: N DDS3FLD,DDS3LEN,DDSX
! 99: D:$P(DDS3C,U,5)]"" XCAP
! 100: ;
! 101: S DY=+DDS3C,DX=$P(DDS3C,U,2)
! 102: S DDS3LEN=$P(DDS3C,U,3),DDS3FLD=$P(DDS3C,U,4)
! 103: ;
! 104: ;Computed flds
! 105: I DDS3DA]"",$P(DDS3C,U,9) S DDSX=$$VAL^DDSCOMP(DDS3DDO,DDS3B,DDS3DA)
! 106: ;
! 107: ;Form only flds
! 108: Q:DDS3FLD=""
! 109: I DDS3FLD'=+DDS3FLD N DDS3FN S DDS3FN="F0"
! 110: ;
! 111: ;External form
! 112: S:DDS3FLD DDSX=$S(DDS3DA="":"",$D(@DDSREFT@(DDS3FN,DDS3DA,DDS3FLD,"X"))#2:^("X"),1:$G(^("D")))
! 113: I $G(DDSX)]""!$G(DDS3FLG) D
! 114: . S:$D(DDSX)[0 DDSX=""
! 115: . X IOXY
! 116: . I '$P(DDS3C,U,10) S DDSX=$E(DDSX,1,DDS3LEN)_$J("",DDS3LEN-$L(DDSX))
! 117: . E S DDSX=$J("",DDS3LEN-$L(DDSX))_$E(DDSX,1,DDS3LEN)
! 118: . W $P(DDGLVID,DDGLDEL)_DDSX_$P(DDGLVID,DDGLDEL,10)
! 119: Q
! 120: ;
! 121: XCAP ;Paint exec caps
! 122: N Y,DDSLN,DDSSN
! 123: I 'DDS3DA N DA,D0 S (DA,D0)=""
! 124: ;
! 125: I DDS3DA N DDSDL S DDSDL=$L(DDS3DA,",")-2
! 126: I N DA,@$$D0^DDS(DDSDL)
! 127: I D BLDDA^DDS(DDS3DA)
! 128: ;
! 129: S DDS3TP=$P($G(@DDSREFS@(DDS3P,DDS3B)),U,5)
! 130: S DDS3L0=$G(^DIST(.404,DDS3B,40,DDS3DDO,0)) G:DDS3L0?."^" XCAPQ
! 131: S DDS3L01=$G(^DIST(.404,DDS3B,40,DDS3DDO,.1)) G:DDS3L01?."^" XCAPQ
! 132: ;
! 133: S:$D(DDS3LN) DDSLN=DDS3LN
! 134: S:$D(DDS3SN) DDSSN=DDS3SN
! 135: ;
! 136: X DDS3L01 G:$G(Y)="" XCAPQ
! 137: S DDS3CAP=Y
! 138: ;
! 139: I DDS3TP="e","^2^3^"_(U_$P(DDS3L0,U,3)_U)!'$P(DDS3L0,U,3) D
! 140: . S Y=$TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
! 141: . S @DDSREFT@("XCAP",DDS3P,DDS3B,Y,DDS3DDO)=""
! 142: ;
! 143: S DY=$P(DDS3C,U,5),DX=$P(DDS3C,U,6)
! 144: S DDS3CAP=DDS3CAP_$P(DDS3C,U,7)
! 145: S:$P(DDS3C,U,8) DDS3CAP=$P(DDGLVID,DDGLDEL,4)_DDS3CAP_$P(DDGLVID,DDGLDEL,10)
! 146: X IOXY W DDS3CAP
! 147: XCAPQ K DDS3CAP,DDS3L0,DDS3L01,DDS3TP
! 148: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>