DDS01 ;SFISC/MLH,MKO-PROCESS BLOCK ;24JAN2013
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;***BE CAREFUL PUTTING TAGS INTO THIS IMPORTANT ROUTINE! $T LOOKS FOR A NON-EXISTENCE OF A TAG!****
;
F D IN,CHK Q:"^Q^NB^NP^"[(U_DDACT_U)
Q
;
IN K DDSBR,DDSFLD,DDSO,DDSU,DIR,DDSREPNT
S:$D(@DDSREFS@(DDSPG,$S(DDO:DDSBK,1:0),DDO,"N"))#2 DDSU("N")=^("N")
I DDM,'$G(DDSKM) D CLRMSG^DDS
G:'DDO COM^DDSCOM
;
S DDSOSV=0
F DDSI=0,1,2,4,7,10:1:14,20 D ;MOVE FIELD DEFINITION INTO DDSO ARRAY
. S:$D(^DIST(.404,DDSBK,40,DDO,DDSI))#2 DDSO(DDSI)=^(DDSI)
K DDSI
;
S DDSFLD=$G(DDSO(1)) K DDSO(1)
I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0,DDSFLD=DDO_","_DDSBK
;
I DDSFLD]"",DDSDA]"" M DDSU=@DDSREFT@("F"_DDP,DDSDA,DDSFLD) ;Restore field's specs & value from ^TMP
;
I '$D(DDSREP)!DDSDA,$$UNED($G(DDSU("A")),$G(DDSO(4)),$G(DDSU("N"))) D Q
. I $D(DDSACT)#2 S DDACT=DDSACT K DDSACT
. S:DDACT="U" DDACT="L"
. S:DDACT="D" DDACT="R"
. D CURSOR Q:$D(DDSBR)#2
. S DDSCHKQ=1
K DDSACT
;
S (X,DDSOLD)=$G(DDSU("D")),DDSEXT=$G(DDSU("X"),X)
;
X:$G(DDSO(11))'?."^" DDSO(11) ;PRE-ACTION
I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
I DDACT]"",$T(@DDACT)]"" D @DDACT S DDSCHKQ=1 Q
;
S DIR0N=1 Q:DDSFLD=""
;
S:$G(^DD(DDP,DDSFLD,0))'?."^" DDSU("DD")=^(0)
I $D(DDSU("N"))[0 S DDACT="N" Q
Q:$D(DDSO(2))[0
;
D:$G(@DDSREFT@("HLP"))>0 HLP^DDSMSG()
K DDSKM,DDQ
;
S DIR0=$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,1,3)
S:$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,10) $P(DIR0,U,6)=1
HITE S:$P($G(DDSREP),U,3)>1 $P(DIR0,U)=$P(DIR0,U)+($P(DDSREP,U,3)-1*$$HITE^DDSR(DDSBK)) ;DJW/GFT
;
I $D(DDSREP),'DDSDA,$P(DDSO(0),U,3)'=2 K DDSU("DD") G SEL^DDSM
I $D(DDSU("M"))#2 S DDSGL=U_$P(DDSU("M"),U,2) G:'DDSU("M") WP^DDSWP
S DIR("B")=$G(DDSU("X"),DDSOLD)
;
I $D(DDSU("M"))#2 D SEL^DDS5 G:X'=DDSOLD&(DDACT="N") EXT
I $P($G(DDSO(0)),U,3)'=2 S DIR(0)=DDP_","_DDSFLD_"O" ;IT'S A FIELD-TYPE READ
E D DIR^DDSFO
D ^DIR K DIR,DUOUT,DIRUT,DIROUT ;DO THE READ!
I DIR0N S (X,Y)=DDSOLD Q
;
EXT I $E(X)=U!$D(DTOUT) S DIR0N=1 Q
G EXT^DDS02
;
CHK Q:$D(DDSBR)#2
I $G(DDSCHKQ)=1 K DDSCHKQ Q
G:$D(DTOUT) TO^DDS3
G:$E(X)=U UPA^DDS2
I $G(DDSFLD)=.01,X="",$G(DA),DDSOLD]"" G ^DDS6 ;DELETE ENTRY
;
I $P($G(DDSU("DD")),U,2)["I",$G(DDSOLD)]"" D I %]"",X'=% S DDSNOED=1 ;UNEDITABLE FIELD ALREADY HAS A VALUE
.N DIERR S %=$$GET1^DIQ(DDSFILE,DDSDA,DDSFLD)
E I $P($G(DDSU("DD")),U,5,99)["DINUM" S DDSNOED=1
E S DDSNOED=$S($P($G(DDSU("A")),U,4)="":$P($G(DDSO(4)),U,4),1:$P($G(DDSU("A")),U,4)) ;FIELD 6.4 ('DISABLE EDITING') IN THE FIELD MULTIPLE
I $G(DDSFLD)]"",$G(DDSOLD)]"",X'=DDSOLD,DDSNOED S %=1 D I %["," S DDSDA=% D POSDA^DDSM(DDSDA,DDSOLD) K DDSCHKQ Q
.N F,L
.I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0,F="" F S F=$O(@DDSREFT@("F0",F)) Q:F="" D Q:%[","
..S L="" F S L=$O(@DDSREFT@("F0",F,L)) Q:L="" I +L=DDO,$P(L,",",2)=DDSBK,$P($G(@DDSREFT@("F0",F,L,"O")),X)="" S %=F Q ;FIND A MATCHING FORM-ONLY VALUE
.I %'["," S F="" F S F=$O(@DDSREFT@("F"_DDP,F)) Q:F="" D Q:%[","
..I F'=DDSDA S L=$G(@DDSREFT@("F"_DDP,F,DDSFLD,"D")) I L]"",$P(L,X)="" S %=F ;FIND A MATCHING FIELD VALUE
.S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD S:$D(DDSU("X"))#2 ^("X")=DDSU("X")
.
I 'DIR0N,$G(DDSFLD),$D(DDSU("M"))[0,$G(DDSCHKQ)'=2,DDSNOED D K DDSNOED Q ;User tried to change uneditable field (was UNED^DDS02)
.S %=$P($G(DDSO(0)),U,2) I %="" S %=$P($G(DDSO(0)),U,5) ;GET CAPTION or UNIQUE NAME
.D MSG^DDSMSG($$EZBLD^DIALOG(3090,%),1) ;'UNEDITABLE'
.I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0
.S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD S:$D(DDSU("X"))#2 ^("X")=DDSU("X")
;
K DDSCHKQ,DDSNOED
;
I $G(DDSFLD)=.01,$G(DDSPTB)]"",$G(DDSREP)<2,'DIR0N D RPF^DDS7(DDP,DDSPTB,DDSDA,.DA)
I $G(DDSO(12))'?."^" X DDSO(12) ;POST ACTION
;
I 'DIR0N,DDO,$G(DDSFLD)]"" D
. I $P($G(DDSO(0)),U,3)=2 N DDP S DDP=0
. S DDSCHG=1
. I DDSDA!'$D(DDSREP),+$G(DDSU("F"))'=1 S $P(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,"F"),U)=1
. I $G(DDSO(13))'?."^" X DDSO(13) ;POST ACTION ON CHANGE
. D:$D(@DDSREFS@("PT",DDP,DDSFLD)) RPB^DDS7(DDP,DDSFLD,DDSPG)
. D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF^DDSCOMP(DDSPG)
;
I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
Q:DDACT="" I $T(@DDACT)]"" G @DDACT
I 'DDO G:X]"" ^DDS3 S DDSO(0)=0
I DDACT="D",$D(DDSREP),'DA S DDACT="N" ;GFT DON'T DOWN-ARROW THRU A MULTIPLE THAT HAS NO .01 FIELD DEFINED
G:"^U^D^R^L^"[(U_DDACT_U) CURSOR
G:$D(DDSU("M"))[0 NF
G:DDSU("M") ^DDS5
D EDIT^DDSWP I '$D(DDGLCLR) S DDACT="Q" Q
D R^DDSR
;
NF I 'DDO,DDSOSV S DDO=DDSOSV Q
;
I DDO,$S($D(DDSREP):DDSDA,1:1) D
. D:'$D(DDSU("M"))
.. I $G(@DDSREFS@("ASUB",DDSPG,DDSBK,DDO))]"" S DDSSTACK="`"_^(DDO) ;ANOTHER PAGE HAS THIS FIELD AS ITS PARENT FIELD!
.. E I $P($G(DDSO(7)),U,2)]"" S DDSSTACK=$P(DDSO(7),U,2) ;OR THERE IS A SUBPAGE LINK FROM THIS FIELD
. X:$G(DDSO(10))'?."^" DDSO(10) ;BRANCHING LOGIC
;
I $D(DDSSTACK) D:$G(^DIST(.403,+DDS,21400)) REFRESH^DDS02(DDSSTACK) D ^DDSSTK,R^DDS3 K DDSU ;WE DO A WHOLE RECURSION TO THE SUBPAGE, AND THEN REPAINT THIS PAGE
I $D(DDSBR)#2 D BR^DDS2 Q:$D(DDSBR)#2
S DDACT="N"
;
CURSOR N ACT,B,BLK,BLK0,FND,N,REP
K DDSACT
S:$D(DDSU("N"))[0 DDSU("N")=$G(@DDSREFS@(DDSPG,DDSBK,DDO,"N"))
S FND=0
I $D(DDSREP),DDO D MNAV^DDSM(.FND) Q:FND
;
S B=U,(BLK,BLK0)=DDSBK,N=DDSU("N"),ACT=$S(DDO&$G(DDSDN):"N",1:DDACT)
F D Q:FND!$D(REP)
. S DDO=$P(N,U,$L($P("U^D^R^L^N",ACT),U))
. I 'DDO S (DDO,DDSBK)=0,FND=1 Q
. ;
. S DDSBK=$P(DDO,",",2),DDO=+DDO
. I DDSBK D Q:$D(REP)
.. I $P($G(@DDSREFS@(DDSPG,DDSBK)),U,4) D
... S DDO=$P($G(@DDSREFS@(DDSPG,DDSBK)),U,9),ACT="N"
.. E S ACT=DDACT
.. I '$P($G(@DDSREFT@(DDSPG,DDSBK)),U),DDSDAORG S B=B_DDSBK_U
.. E I $P(@DDSREFS@(DDSPG,DDSBK),U,7)>1 S REP=1,DDACT="NB",DDSBR=""
. E S DDSBK=BLK
. ;
. I B'[(U_DDSBK_U) S FND=1 S:DDSBK'=BLK0 DDACT="NB",DDSBR="",DDSACT=ACT
. ;
. S:'FND N=$G(@DDSREFS@(DDSPG,DDSBK,+DDO,"N")),BLK=DDSBK
Q
;
NP ;;
G:$D(DDSREP)&DDO PGDN^DDSM ;If in REPEATING BLOCK
S:DDSNP]"" DDSPG=DDSNP
S:DDSNP="" DDACT="N"
Q
PP ;;
G:$D(DDSREP)&DDO PGUP^DDSM ;If in REPEATING BLOCK
S DDSPG=$$PP^DDS5(.Y)
S DDACT=$S(Y=1:"NP",1:"N")
Q
NB ;;
S DDSBK=$$NB^DDS5(.Y),DDACT=$S(Y=1:"NB",1:"N")
Q
SEL ;;
;I $G(DDSSEL) W $C(7) Q
S DDACT="N" G PG^DDSRSEL
SV ;;
G SV^DDS02
QT ;;
G QT^DDS3
EX ;;
G EX^DDS3
CL ;;
G CL^DDS3
MOUSE ;;
G MOUSE^DDS2
PRNT ;;
D EN^DDSRP(+DDS,DDSPG)
RF ;;
S DDACT="N" I $G(^DIST(.403,+DDS,21400)) D REFRESH^DDS02(DDSPG) ;RE-DO THE DATA BEFORE REFRESHING PAGE
G R^DDSR
;
;
UNED(ATT,DEF,N) ;
Q $S(N="":1,$P(ATT,U,4)="":$P(DEF,U,4)=1,1:$P(ATT,U,4)=1)&'$P(N,U,11)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDS01 6904 printed Dec 13, 2024@02:42:59 Page 2
DDS01 ;SFISC/MLH,MKO-PROCESS BLOCK ;24JAN2013
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;***BE CAREFUL PUTTING TAGS INTO THIS IMPORTANT ROUTINE! $T LOOKS FOR A NON-EXISTENCE OF A TAG!****
+8 ;
+9 FOR
DO IN
DO CHK
if "^Q^NB^NP^"[(U_DDACT_U)
QUIT
+10 QUIT
+11 ;
IN KILL DDSBR,DDSFLD,DDSO,DDSU,DIR,DDSREPNT
+1 if $DATA(@DDSREFS@(DDSPG,$SELECT(DDO
SET DDSU("N")=^("N")
+2 IF DDM
IF '$GET(DDSKM)
DO CLRMSG^DDS
+3 if 'DDO
GOTO COM^DDSCOM
+4 ;
+5 SET DDSOSV=0
+6 ;MOVE FIELD DEFINITION INTO DDSO ARRAY
FOR DDSI=0,1,2,4,7,10:1:14,20
Begin DoDot:1
+7 if $DATA(^DIST(.404,DDSBK,40,DDO,DDSI))#2
SET DDSO(DDSI)=^(DDSI)
End DoDot:1
+8 KILL DDSI
+9 ;
+10 SET DDSFLD=$GET(DDSO(1))
KILL DDSO(1)
+11 IF $PIECE($GET(DDSO(0)),U,3)=2
NEW DDP
SET DDP=0
SET DDSFLD=DDO_","_DDSBK
+12 ;
+13 ;Restore field's specs & value from ^TMP
IF DDSFLD]""
IF DDSDA]""
MERGE DDSU=@DDSREFT@("F"_DDP,DDSDA,DDSFLD)
+14 ;
+15 IF '$DATA(DDSREP)!DDSDA
IF $$UNED($GET(DDSU("A")),$GET(DDSO(4)),$GET(DDSU("N")))
Begin DoDot:1
+16 IF $DATA(DDSACT)#2
SET DDACT=DDSACT
KILL DDSACT
+17 if DDACT="U"
SET DDACT="L"
+18 if DDACT="D"
SET DDACT="R"
+19 DO CURSOR
if $DATA(DDSBR)#2
QUIT
+20 SET DDSCHKQ=1
End DoDot:1
QUIT
+21 KILL DDSACT
+22 ;
+23 SET (X,DDSOLD)=$GET(DDSU("D"))
SET DDSEXT=$GET(DDSU("X"),X)
+24 ;
+25 ;PRE-ACTION
if $GET(DDSO(11))'?."^"
XECUTE DDSO(11)
+26 IF $DATA(DDSBR)#2
DO BR^DDS2
if $DATA(DDSBR)#2
QUIT
+27 IF DDACT]""
IF $TEXT(@DDACT)]""
DO @DDACT
SET DDSCHKQ=1
QUIT
+28 ;
+29 SET DIR0N=1
if DDSFLD=""
QUIT
+30 ;
+31 if $GET(^DD(DDP,DDSFLD,0))'?."^"
SET DDSU("DD")=^(0)
+32 IF $DATA(DDSU("N"))[0
SET DDACT="N"
QUIT
+33 if $DATA(DDSO(2))[0
QUIT
+34 ;
+35 if $GET(@DDSREFT@("HLP"))>0
DO HLP^DDSMSG()
+36 KILL DDSKM,DDQ
+37 ;
+38 SET DIR0=$PIECE(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,1,3)
+39 if $PIECE(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,10)
SET $PIECE(DIR0,U,6)=1
HITE ;DJW/GFT
if $PIECE($GET(DDSREP),U,3)>1
SET $PIECE(DIR0,U)=$PIECE(DIR0,U)+($PIECE(DDSREP,U,3)-1*$$HITE^DDSR(DDSBK))
+1 ;
+2 IF $DATA(DDSREP)
IF 'DDSDA
IF $PIECE(DDSO(0),U,3)'=2
KILL DDSU("DD")
GOTO SEL^DDSM
+3 IF $DATA(DDSU("M"))#2
SET DDSGL=U_$PIECE(DDSU("M"),U,2)
if 'DDSU("M")
GOTO WP^DDSWP
+4 SET DIR("B")=$GET(DDSU("X"),DDSOLD)
+5 ;
+6 IF $DATA(DDSU("M"))#2
DO SEL^DDS5
if X'=DDSOLD&(DDACT="N")
GOTO EXT
+7 ;IT'S A FIELD-TYPE READ
IF $PIECE($GET(DDSO(0)),U,3)'=2
SET DIR(0)=DDP_","_DDSFLD_"O"
+8 IF '$TEST
DO DIR^DDSFO
+9 ;DO THE READ!
DO ^DIR
KILL DIR,DUOUT,DIRUT,DIROUT
+10 IF DIR0N
SET (X,Y)=DDSOLD
QUIT
+11 ;
EXT IF $EXTRACT(X)=U!$DATA(DTOUT)
SET DIR0N=1
QUIT
+1 GOTO EXT^DDS02
+2 ;
CHK if $DATA(DDSBR)#2
QUIT
+1 IF $GET(DDSCHKQ)=1
KILL DDSCHKQ
QUIT
+2 if $DATA(DTOUT)
GOTO TO^DDS3
+3 if $EXTRACT(X)=U
GOTO UPA^DDS2
+4 ;DELETE ENTRY
IF $GET(DDSFLD)=.01
IF X=""
IF $GET(DA)
IF DDSOLD]""
GOTO ^DDS6
+5 ;
+6 ;UNEDITABLE FIELD ALREADY HAS A VALUE
IF $PIECE($GET(DDSU("DD")),U,2)["I"
IF $GET(DDSOLD)]""
Begin DoDot:1
+7 NEW DIERR
SET %=$$GET1^DIQ(DDSFILE,DDSDA,DDSFLD)
End DoDot:1
IF %]""
IF X'=%
SET DDSNOED=1
+8 IF '$TEST
IF $PIECE($GET(DDSU("DD")),U,5,99)["DINUM"
SET DDSNOED=1
+9 ;FIELD 6.4 ('DISABLE EDITING') IN THE FIELD MULTIPLE
IF '$TEST
SET DDSNOED=$SELECT($PIECE($GET(DDSU("A")),U,4)="":$PIECE($GET(DDSO(4)),U,4),1:$PIECE($GET(DDSU("A")),U,4))
+10 IF $GET(DDSFLD)]""
IF $GET(DDSOLD)]""
IF X'=DDSOLD
IF DDSNOED
SET %=1
Begin DoDot:1
+11 NEW F,L
+12 IF $PIECE($GET(DDSO(0)),U,3)=2
NEW DDP
SET DDP=0
SET F=""
FOR
SET F=$ORDER(@DDSREFT@("F0",F))
if F=""
QUIT
Begin DoDot:2
+13 ;FIND A MATCHING FORM-ONLY VALUE
SET L=""
FOR
SET L=$ORDER(@DDSREFT@("F0",F,L))
if L=""
QUIT
IF +L=DDO
IF $PIECE(L,",",2)=DDSBK
IF $PIECE($GET(@DDSREFT@("F0",F,L,"O")),X)=""
SET %=F
QUIT
End DoDot:2
if %[","
QUIT
+14 IF %'[","
SET F=""
FOR
SET F=$ORDER(@DDSREFT@("F"_DDP,F))
if F=""
QUIT
Begin DoDot:2
+15 ;FIND A MATCHING FIELD VALUE
IF F'=DDSDA
SET L=$GET(@DDSREFT@("F"_DDP,F,DDSFLD,"D"))
IF L]""
IF $PIECE(L,X)=""
SET %=F
End DoDot:2
if %[","
QUIT
+16 SET @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
if $DATA(DDSU("X"))#2
SET ^("X")=DDSU("X")
+17 End DoDot:1
IF %[","
SET DDSDA=%
DO POSDA^DDSM(DDSDA,DDSOLD)
KILL DDSCHKQ
QUIT
+18 ;User tried to change uneditable field (was UNED^DDS02)
IF 'DIR0N
IF $GET(DDSFLD)
IF $DATA(DDSU("M"))[0
IF $GET(DDSCHKQ)'=2
IF DDSNOED
Begin DoDot:1
+19 ;GET CAPTION or UNIQUE NAME
SET %=$PIECE($GET(DDSO(0)),U,2)
IF %=""
SET %=$PIECE($GET(DDSO(0)),U,5)
+20 ;'UNEDITABLE'
DO MSG^DDSMSG($$EZBLD^DIALOG(3090,%),1)
+21 IF $PIECE($GET(DDSO(0)),U,3)=2
NEW DDP
SET DDP=0
+22 SET @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
if $DATA(DDSU("X"))#2
SET ^("X")=DDSU("X")
End DoDot:1
KILL DDSNOED
QUIT
+23 ;
+24 KILL DDSCHKQ,DDSNOED
+25 ;
+26 IF $GET(DDSFLD)=.01
IF $GET(DDSPTB)]""
IF $GET(DDSREP)<2
IF 'DIR0N
DO RPF^DDS7(DDP,DDSPTB,DDSDA,.DA)
+27 ;POST ACTION
IF $GET(DDSO(12))'?."^"
XECUTE DDSO(12)
+28 ;
+29 IF 'DIR0N
IF DDO
IF $GET(DDSFLD)]""
Begin DoDot:1
+30 IF $PIECE($GET(DDSO(0)),U,3)=2
NEW DDP
SET DDP=0
+31 SET DDSCHG=1
+32 IF DDSDA!'$DATA(DDSREP)
IF +$GET(DDSU("F"))'=1
SET $PIECE(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,"F"),U)=1
+33 ;POST ACTION ON CHANGE
IF $GET(DDSO(13))'?."^"
XECUTE DDSO(13)
+34 if $DATA(@DDSREFS@("PT",DDP,DDSFLD))
DO RPB^DDS7(DDP,DDSFLD,DDSPG)
+35 if $DATA(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG))
DO RPCF^DDSCOMP(DDSPG)
End DoDot:1
+36 ;
+37 IF $DATA(DDSBR)#2
DO BR^DDS2
if $DATA(DDSBR)#2
QUIT
+38 if DDACT=""
QUIT
IF $TEXT(@DDACT)]""
GOTO @DDACT
+39 IF 'DDO
if X]""
GOTO ^DDS3
SET DDSO(0)=0
+40 ;GFT DON'T DOWN-ARROW THRU A MULTIPLE THAT HAS NO .01 FIELD DEFINED
IF DDACT="D"
IF $DATA(DDSREP)
IF 'DA
SET DDACT="N"
+41 if "^U^D^R^L^"[(U_DDACT_U)
GOTO CURSOR
+42 if $DATA(DDSU("M"))[0
GOTO NF
+43 if DDSU("M")
GOTO ^DDS5
+44 DO EDIT^DDSWP
IF '$DATA(DDGLCLR)
SET DDACT="Q"
QUIT
+45 DO R^DDSR
+46 ;
NF IF 'DDO
IF DDSOSV
SET DDO=DDSOSV
QUIT
+1 ;
+2 IF DDO
IF $SELECT($DATA(DDSREP):DDSDA,1:1)
Begin DoDot:1
+3 if '$DATA(DDSU("M"))
Begin DoDot:2
+4 ;ANOTHER PAGE HAS THIS FIELD AS ITS PARENT FIELD!
IF $GET(@DDSREFS@("ASUB",DDSPG,DDSBK,DDO))]""
SET DDSSTACK="`"_^(DDO)
+5 ;OR THERE IS A SUBPAGE LINK FROM THIS FIELD
IF '$TEST
IF $PIECE($GET(DDSO(7)),U,2)]""
SET DDSSTACK=$PIECE(DDSO(7),U,2)
End DoDot:2
+6 ;BRANCHING LOGIC
if $GET(DDSO(10))'?."^"
XECUTE DDSO(10)
End DoDot:1
+7 ;
+8 ;WE DO A WHOLE RECURSION TO THE SUBPAGE, AND THEN REPAINT THIS PAGE
IF $DATA(DDSSTACK)
if $GET(^DIST(.403,+DDS,21400))
DO REFRESH^DDS02(DDSSTACK)
DO ^DDSSTK
DO R^DDS3
KILL DDSU
+9 IF $DATA(DDSBR)#2
DO BR^DDS2
if $DATA(DDSBR)#2
QUIT
+10 SET DDACT="N"
+11 ;
CURSOR NEW ACT,B,BLK,BLK0,FND,N,REP
+1 KILL DDSACT
+2 if $DATA(DDSU("N"))[0
SET DDSU("N")=$GET(@DDSREFS@(DDSPG,DDSBK,DDO,"N"))
+3 SET FND=0
+4 IF $DATA(DDSREP)
IF DDO
DO MNAV^DDSM(.FND)
if FND
QUIT
+5 ;
+6 SET B=U
SET (BLK,BLK0)=DDSBK
SET N=DDSU("N")
SET ACT=$SELECT(DDO&$GET(DDSDN):"N",1:DDACT)
+7 FOR
Begin DoDot:1
+8 SET DDO=$PIECE(N,U,$LENGTH($PIECE("U^D^R^L^N",ACT),U))
+9 IF 'DDO
SET (DDO,DDSBK)=0
SET FND=1
QUIT
+10 ;
+11 SET DDSBK=$PIECE(DDO,",",2)
SET DDO=+DDO
+12 IF DDSBK
Begin DoDot:2
+13 IF $PIECE($GET(@DDSREFS@(DDSPG,DDSBK)),U,4)
Begin DoDot:3
+14 SET DDO=$PIECE($GET(@DDSREFS@(DDSPG,DDSBK)),U,9)
SET ACT="N"
End DoDot:3
+15 IF '$TEST
SET ACT=DDACT
+16 IF '$PIECE($GET(@DDSREFT@(DDSPG,DDSBK)),U)
IF DDSDAORG
SET B=B_DDSBK_U
+17 IF '$TEST
IF $PIECE(@DDSREFS@(DDSPG,DDSBK),U,7)>1
SET REP=1
SET DDACT="NB"
SET DDSBR=""
End DoDot:2
if $DATA(REP)
QUIT
+18 IF '$TEST
SET DDSBK=BLK
+19 ;
+20 IF B'[(U_DDSBK_U)
SET FND=1
if DDSBK'=BLK0
SET DDACT="NB"
SET DDSBR=""
SET DDSACT=ACT
+21 ;
+22 if 'FND
SET N=$GET(@DDSREFS@(DDSPG,DDSBK,+DDO,"N"))
SET BLK=DDSBK
End DoDot:1
if FND!$DATA(REP)
QUIT
+23 QUIT
+24 ;
NP ;;
+1 ;If in REPEATING BLOCK
if $DATA(DDSREP)&DDO
GOTO PGDN^DDSM
+2 if DDSNP]""
SET DDSPG=DDSNP
+3 if DDSNP=""
SET DDACT="N"
+4 QUIT
PP ;;
+1 ;If in REPEATING BLOCK
if $DATA(DDSREP)&DDO
GOTO PGUP^DDSM
+2 SET DDSPG=$$PP^DDS5(.Y)
+3 SET DDACT=$SELECT(Y=1:"NP",1:"N")
+4 QUIT
NB ;;
+1 SET DDSBK=$$NB^DDS5(.Y)
SET DDACT=$SELECT(Y=1:"NB",1:"N")
+2 QUIT
SEL ;;
+1 ;I $G(DDSSEL) W $C(7) Q
+2 SET DDACT="N"
GOTO PG^DDSRSEL
SV ;;
+1 GOTO SV^DDS02
QT ;;
+1 GOTO QT^DDS3
EX ;;
+1 GOTO EX^DDS3
CL ;;
+1 GOTO CL^DDS3
MOUSE ;;
+1 GOTO MOUSE^DDS2
PRNT ;;
+1 DO EN^DDSRP(+DDS,DDSPG)
RF ;;
+1 ;RE-DO THE DATA BEFORE REFRESHING PAGE
SET DDACT="N"
IF $GET(^DIST(.403,+DDS,21400))
DO REFRESH^DDS02(DDSPG)
+2 GOTO R^DDSR
+3 ;
+4 ;
UNED(ATT,DEF,N) ;
+1 QUIT $SELECT(N="":1,$PIECE(ATT,U,4)="":$PIECE(DEF,U,4)=1,1:$PIECE(ATT,U,4)=1)&'$PIECE(N,U,11)
