DDSSTK ;SFISC/MKO - STACK CONTEXT, GO TO A NEW PAGE ;18MAR2017
;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
;;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.
;;GFT;**1028,1055,1057**
;
;COME HERE FROM DDS5+11^DDS5 AND NF+8^DDS01 (BECAUSE WE'VE ENCOUNTERED 'DDSSTACK')
N DDO
N DDSBK,DDSDN,DDSFLD,DDSNP,DDSOPB,DDSPG,DDSPTB,DDSREP,DDSTP
;
I DDSSTACK?1"`".E D
. S DDSSTACK=+$E(DDSSTACK,2,999)
E I DDSSTACK=+$P(DDSSTACK,"E") D
. S DDSSTACK=+$O(^DIST(.403,+DDS,40,"B",DDSSTACK,""))
E D
UP . S DDSSTACK=$O(^DIST(.403,+DDS,40,"C",$$UP^DILIBF(DDSSTACK),"")) ;**
;
I 'DDSSTACK!($D(^DIST(.403,+DDS,40,+$G(DDSSTACK),0))[0) D Q ;QUIT IF WE CAN'T FIGURE OUT WHAT PAGE TO GO TO
. K DDSSTACK,DDSBR
;
N DDSDAORG,DDSDLORG,DDSFLORG,DDSPG
S DDSSTK=1,DDSATOP=1 ;INFLUENCES SEL+9^DDS & THEN SETUP+10^DDSCOM
S DDSPG=DDSSTACK
K DDSSTACK,DDSBR
;
S DDSDLORG=DDSDL,DDSDAORG=DA
F DDSI=1:1:DDSDL S DDSDAORG(DDSI)=DA(DDSI)
K DDSI
;
S DDSH=1 ;DDSH tells SM+6^DIR0 to refresh the COMMAND LINE
D PROC^DDS ;RECURSION!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSSTK 1365 printed Jan 18, 2025@03:44:33 Page 2
DDSSTK ;SFISC/MKO - STACK CONTEXT, GO TO A NEW PAGE ;18MAR2017
+1 ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
+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 ;;GFT;**1028,1055,1057**
+7 ;
+8 ;COME HERE FROM DDS5+11^DDS5 AND NF+8^DDS01 (BECAUSE WE'VE ENCOUNTERED 'DDSSTACK')
+9 NEW DDO
+10 NEW DDSBK,DDSDN,DDSFLD,DDSNP,DDSOPB,DDSPG,DDSPTB,DDSREP,DDSTP
+11 ;
+12 IF DDSSTACK?1"`".E
Begin DoDot:1
+13 SET DDSSTACK=+$EXTRACT(DDSSTACK,2,999)
End DoDot:1
+14 IF '$TEST
IF DDSSTACK=+$PIECE(DDSSTACK,"E")
Begin DoDot:1
+15 SET DDSSTACK=+$ORDER(^DIST(.403,+DDS,40,"B",DDSSTACK,""))
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
UP ;**
SET DDSSTACK=$ORDER(^DIST(.403,+DDS,40,"C",$$UP^DILIBF(DDSSTACK),""))
End DoDot:1
+1 ;
+2 ;QUIT IF WE CAN'T FIGURE OUT WHAT PAGE TO GO TO
IF 'DDSSTACK!($DATA(^DIST(.403,+DDS,40,+$GET(DDSSTACK),0))[0)
Begin DoDot:1
+3 KILL DDSSTACK,DDSBR
End DoDot:1
QUIT
+4 ;
+5 NEW DDSDAORG,DDSDLORG,DDSFLORG,DDSPG
IF '$PIECE(^DIST(.403,+DDS,40,+DDSSTACK,0),U,6)
NEW DDSSC
+1 ;INFLUENCES SEL+9^DDS & THEN SETUP+10^DDSCOM
SET DDSSTK=1
SET DDSATOP=1
+2 SET DDSPG=DDSSTACK
+3 KILL DDSSTACK,DDSBR
+4 ;
+5 SET DDSDLORG=DDSDL
SET DDSDAORG=DA
+6 FOR DDSI=1:1:DDSDL
SET DDSDAORG(DDSI)=DA(DDSI)
+7 KILL DDSI
+8 ;
+9 ;DDSH tells SM+6^DIR0 to refresh the COMMAND LINE
SET DDSH=1
+10 ;RECURSION!
DO PROC^DDS
+11 QUIT
