Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDSRUN

DDSRUN.m

Go to the documentation of this file.
  1. DDSRUN ;SFISC/MKO-RUN A FORM ;6JUL2013
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;Select file (DDSFILE)
  1. EGP S DDS1=8108.3 D W^DICRW K DDS1 G:Y<0 RUNQ ;**CCO/NI 'RUN FORM:'
  1. G:'$D(@(DIC_"0)")) RUNQ
  1. K DDSFILE S DDSFILE=+Y
  1. ;
  1. ;Select form (DDSRUNDR)
  1. K DIC
  1. S DIC=.403,DIC(0)="QEA",D="F"_+Y
  1. S DIC("S")="I $P(^(0),U,8)=+DDSFILE"
  1. I DUZ(0)'="@" S DIC("S")=DIC("S")_" N DDSI F DDSI=1:1:$L($P(^(0),U,2)) I DUZ(0)[$E($P(^(0),U,2),DDSI) Q"
  1. W ! D IX^DIC K DIC,D G:Y<0 RUNQ
  1. S DDSRUNDR=+Y
  1. ;
  1. I '$$COMPILED^DDS0(DDSRUNDR) D EN^DDSZ(DDSRUNDR) G:$G(DIERR) RUNQ
  1. ;
  1. ;Select page (DDSPAGE)
  1. PAGE S DDSPAGE=$$MULSELPG(DDSRUNDR) I DDSPAGE]"" K DA G GO ;IF THERE'S A RECORD SELECTION PAGE WITH MULTIPLES, USE IT
  1. K DIR S Y=$O(^DIST(.403,DDSRUNDR,40,0)) I '$O(^(Y)) S DDSPAGE=1 G REC ;DON'T ASK PAGE IF THERE IS ONLY ONE!
  1. S DIR(0)="NOA^1:999.9:1"
  1. S DIR("A")="Enter number of first page: ",DIR("B")=1
  1. W ! D ^DIR K DIR G:$D(DIRUT) RUNQ
  1. K DDSPAGE S:Y'=1 DDSPAGE=Y
  1. ;
  1. REC ;Select record (DA)
  1. K DA
  1. D G:DA<0 RUNQ
  1. . S DIC=DDSFILE,DIC(0)="QEALM"
  1. . W ! D ^DIC K DIC
  1. . S DA=+Y
  1. K D,DIC,X,Y
  1. ;
  1. ;Invoke form
  1. GO K DR S DR=DDSRUNDR D ^DDS G:$D(DA) REC
  1. ;
  1. RUNQ ;Clean up and quit
  1. I $D(DIERR) W !,$C(7) D MSG^DIALOG("BW")
  1. K D,DIC,X,Y
  1. K DDSFILE,DDSPAGE,DDSRUNDR,DA,DR
  1. K DIRUT,DTOUT,DUOUT
  1. Q
  1. ;
  1. MULSELPG(DDS) ;RETURN RECORD SELECTION PAGE IF IT IS NOT A POP-UP, I.E. IF IT IS A NEW-STYLE MULTIPLE SELECTION PAGE
  1. N Y,P S Y=$G(^DIST(.403,+DDS,21)) I Y]"" S P=$O(^(40,"B",Y,0)) I P,'$P(^DIST(.403,+DDS,40,P,0),U,6) Q Y
  1. Q ""