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