Annotation of freem_fileman/USER/DDS.m, revision 1.1
1.1 ! snw 1: DDS ;SFISC/MLH,MKO-MAIN ROUTINE ;02:33 PM 15 Nov 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: N DIE,DX,DY,X,Y
! 5: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
! 6: ;
! 7: D EN^DDS0(.DDSFILE,DR,.DA)
! 8: I $G(DIERR) D:$G(DDSPARM)'["E" G END^DDS0
! 9: . W !,$C(7)_$$EZBLD^DIALOG(3000)
! 10: . D MSG^DIALOG("BW")
! 11: . S DIMSG=""
! 12: ;
! 13: N DR
! 14: X:$G(^DIST(.403,+DDS,11))'?."^" ^(11)
! 15: F D PG Q:DDACT="Q"
! 16: X:$G(^DIST(.403,+DDS,12))'?."^" ^(12)
! 17: ;
! 18: D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
! 19: G END^DDS0
! 20: ;
! 21: PROC ;Main loop
! 22: F D PG Q:DDACT="Q"
! 23: Q
! 24: ;
! 25: PG ;Get DDSPOP and update DDSSC array
! 26: ;If we're going to another page
! 27: S DDACT="N"
! 28: I '$D(DDSPGUP) D
! 29: . S DDSLN=^DIST(.403,+DDS,40,DDSPG,0),DDSPOP=$P(DDSLN,U,6)
! 30: . K:'DDSPOP DDSSC
! 31: . I '$D(DDSSC("B",DDSPG)) D
! 32: .. S DDSSC=$G(DDSSC)+1,DDSSC(DDSSC)=DDSPG,DDSSC("B",DDSPG,DDSSC)=""
! 33: .. S:DDSPOP $P(DDSSC(DDSSC),U,2,3)=$P(DDSLN,U,3)_U_$P(DDSLN,U,7)
! 34: .. I $G(DDSSTK) S $P(DDSSC(DDSSC),U,4)=1 K DDSSTK
! 35: .. K DDSPOP
! 36: . E D
! 37: .. Q:$P($G(DDSSC(+$G(DDSSC))),U)=DDSPG
! 38: .. N I,J,S
! 39: .. S I=$O(DDSSC("B",DDSPG,"")),S=DDSSC(I) K DDSSC("B",DDSPG,I)
! 40: .. F J=I:1:DDSSC-1 D
! 41: ... K DDSSC("B",$P(DDSSC(J+1),U),J)
! 42: ... S DDSSC(J)=DDSSC(J+1),DDSSC("B",$P(DDSSC(J),U),J)=""
! 43: .. S DDSSC(DDSSC)=S,DDSSC("B",DDSPG,DDSSC)=""
! 44: ;
! 45: ;If we've moving up from a pop-up page
! 46: E K DDSPGUP
! 47: ;
! 48: ;Pre-action, save old and get next page
! 49: S DDSOPB=DDSPG
! 50: I $G(^DIST(.403,+DDS,40,DDSPG,11))'?."^" D PA(^(11)) Q:DDACT="NP"
! 51: S DDSNP=$$NP^DDS5(.Y) S:'Y DDSNP=""
! 52: ;
! 53: ;Load page
! 54: D ^DDS1(DDSPG)
! 55: I $G(DIERR) D Q
! 56: . N P S P(1)=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U),P(2)=$P($G(^(1)),U)
! 57: . S:P(2)="" P(2)="unnamed"
! 58: . D BLD^DIALOG(3041,.P),ERR^DDSMSG
! 59: . S DDACT="Q"
! 60: ;
! 61: ;Get DDO and DDSBK
! 62: I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
! 63: . S DDO=+@DDSREFS@(DDSPG,"FIRST"),DDSBK=$P(^("FIRST"),",",2)
! 64: I 'DDSBK D Q
! 65: . D BLD^DIALOG(3055,"number "_$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U)_$S($G(^(1))]"":" ("_$P($G(^(1)),U)_")",1:""))
! 66: . S DDACT="Q"
! 67: ;
! 68: ;Paint the page
! 69: D RP^DDSR(DDSSC(DDSSC),DDSSC=1)
! 70: ;
! 71: P1 F D BLK Q:"^Q^NP^"[(U_DDACT_U)
! 72: ;
! 73: ;Post action, print any help
! 74: D:$G(^DIST(.403,+DDS,40,+DDSOPB,12))'?."^" PA(^(12))
! 75: D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
! 76: G:"^NB^N^"[(U_DDACT_U) P1
! 77: ;
! 78: I DDACT="Q" D
! 79: . I '$P(DDSSC(DDSSC),U,4) D
! 80: .. D:$G(DDSSEL) GDA^DDSRSEL
! 81: .. D:$G(DDSSC)>1 CLEAR^DDSBOX($P(DDSSC(DDSSC),U,2),$P(DDSSC(DDSSC),U,3))
! 82: .. S:DDSSC>1 DDSPG=$P(DDSSC(DDSSC-1),U),DDACT="N",DDSPGUP=1
! 83: . K DDSSC("B",$P(DDSSC(DDSSC),U),DDSSC),DDSSC(DDSSC) S DDSSC=DDSSC-1
! 84: Q
! 85: ;
! 86: BLK S DDACT="N",DDSOSV=0
! 87: ;
! 88: I $D(@DDSREFS@(DDSPG,DDSBK))[0 S DDACT="Q" Q
! 89: S DDSLN=@DDSREFS@(DDSPG,DDSBK)
! 90: ;
! 91: S DDSDN=$P(DDSLN,U,4),DDSTP=$P(DDSLN,U,5)
! 92: S DDSREP=$P(DDSLN,U,7),DDSPTB=$P(DDSLN,U,8)
! 93: K:'DDSDN DDSDN K:DDSTP="e" DDSTP K:'DDSPTB DDSPTB K:DDSREP'>1 DDSREP
! 94: ;
! 95: I $D(DDSPTB)!$D(DDSREP) N DDP,DDSDA,DIE D
! 96: . S DDP=$P(DDSLN,U,3)
! 97: . S DDSDA=$P(@DDSREFT@(DDSPG,DDSBK),U) Q:DDSDA=""
! 98: . S DIE=@DDSREFT@(DDSPG,DDSBK,DDSDA,"GL")
! 99: ;
! 100: I $D(DDSPTB) N DA,@$$D0(DDSDL),DDSDL D
! 101: . S DDSPTB=@DDSREFS@(DDSPG,DDSBK,"PTB")
! 102: . S DDSDL=$L(DDSDA,",")-2
! 103: . S (D0,DA)=+DDSDA
! 104: ;
! 105: I $D(DDSREP) N DDSDL,DA D
! 106: . S DDSREP=$P(@DDSREFT@(DDSPG,DDSBK,DDSDA),U,2,999)
! 107: . S DDSDL=$L(DDSDA,",")-1
! 108: . S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),$P(DDSREP,U,4)),"0,"_DDSDA)
! 109: I N @$$D0(DDSDL) D
! 110: . D BLDDA(DDSDA)
! 111: . S:'DA DDO=+$P(DDSREP,U,8)
! 112: ;
! 113: I $D(DDSPTB),DDSDA="" D Q
! 114: . S DDSBK=$$NB^DDS5(.Y) Q:Y
! 115: . I DDSNP]"" S DDSPG=DDSNP,DDACT="NP" Q
! 116: . S DDSPG=$$PP^DDS5(.Y) I Y S DDACT="NP" Q
! 117: ;
! 118: S $P(DDSOPB,U,2)=DDSBK
! 119: I $G(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
! 120: I $G(^DIST(.404,DDSBK,11))'?."^" D PA(^(11)) Q:DDACT="NP"
! 121: I $S($D(DDSBR)[0:1,1:$D(@DDSREFS@(DDSPG,$S(DDO:+DDSBK,1:0),DDO,"N"))[0) D
! 122: . S DDO=$P(@DDSREFS@(DDSPG,DDSBK),U,9)
! 123: K DDSLN
! 124: ;
! 125: B1 D ^DDS01
! 126: ;
! 127: I $G(^DIST(.403,+DDS,40,DDSPG,40,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
! 128: I $G(^DIST(.404,$P(DDSOPB,U,2),12))'?."^" D PA(^(12)) G:DDACT="N" B1
! 129: Q
! 130: ;
! 131: BLDDA(DDSDA) ;
! 132: N I
! 133: S (DA,@("D"_DDSDL))=$P(DDSDA,",")
! 134: F I=1:1:DDSDL S (DA(I),@("D"_(DDSDL-I)))=$P(DDSDA,",",I+1)
! 135: Q
! 136: ;
! 137: D0(DL) ;Given DL, return string D0,D1,...,Dn
! 138: N I,S
! 139: S S="" F I=0:1:DL S S=S_"D"_I_","
! 140: S:S?.E1"," S=$E(S,1,$L(S)-1)
! 141: Q S
! 142: ;
! 143: CLRMSG ;
! 144: K DDQ S DDSH=1,(DDM,DX)=0,DY=DDSHBX+1 X DDXY W $P(DDGLCLR,DDGLDEL,3)
! 145: Q
! 146: ;
! 147: PA(DDSPA) ;
! 148: N DDSBRORG S:$D(DDSBR)#2 DDSBRORG=DDSBR
! 149: K DDSBR X DDSPA
! 150: I $D(DDSBR)[0 S:$D(DDSBRORG)#2 DDSBR=DDSBRORG Q
! 151: D BR^DDS2
! 152: Q
! 153: RESET ;Programmer entry point to reset terminal and cleanup
! 154: D INIT^DDGLIB0() D:$G(DIERR) MSG^DIALOG("BW")
! 155: W $P($G(DDGLVID),DDGLDEL,10)
! 156: K DDSPARM
! 157: S DDSREFT="^TMP(""DDS"",$J)"
! 158: D END^DDS0
! 159: G RESET^DDGF
! 160: ;
! 161: RUN ;Run a form
! 162: G ^DDSRUN
! 163: CLONE ;Clone a form
! 164: G ^DDSCLONE
! 165: PRINT ;Print a form
! 166: G ^DDSPRNT
! 167: DFRM ;Delete a form
! 168: G ^DDSDFRM
! 169: DBLK ;Delete unused blocks
! 170: G ^DDSDBLK
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDS.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER