DDSSTK.m

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

POPUP I '$P(^DIST(.403,+DDS,40,+DDSSTACK,0),U,6) N DDSSC ;(Page array) if NOT going to a POPUP PAGE

 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 ---DDSSTK   1365     printed  Dec 13, 2024@02:43:34                                                                                                                                                                                                      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

POPUP     ;(Page array) if NOT going to a POPUP PAGE

           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