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

DDS10.m

Go to the documentation of this file.
  1. DDS10 ;SFISC/MKO-BLOCK SETUP ;21SEP2006
  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. SET(DDS1B,DDS1E,DA,DDP,DIE,DL,DDSDA) ;Get values for pointed-to block
  1. ;In:
  1. ; DDS1B = Block number or [Block name] (by ref)
  1. ; DDS1E = 1, if we're loading a pointed-to block and we want
  1. ; interactive dialog (DIC(0)["E") in the lookup
  1. ; DA = Record array
  1. ;Returns:
  1. ; DDS1B = Block number
  1. ; DDP = File number of block
  1. ; DIE = Global root based on DDP and DA
  1. ; DL = Level number (top=0)
  1. ; DDSDA = DA,DA(1),...,
  1. ;
  1. D BK(.DDS1B,.DDP) Q:$G(DIERR)
  1. D GDA(DDS1B,DDS1E,.DA) Q:$G(DIERR)
  1. D GL(DDP,.DA,.DIE,.DL,.DDSDA,$P($G(^DIST(.403,+DDS,40,+$G(DDSPG),40,DDS1B,0)),U,4)'="d") Q:$G(DIERR) ;Don't LOCK record if block is display-only
  1. Q
  1. ;
  1. BK(DDSBK,DDP) ;Lookup block, get file number
  1. ;Input:
  1. ; DDSBK = Block number or [Block name] (by ref)
  1. ;Returns:
  1. ; DDSBK = Block number
  1. ; DDP = File number
  1. ; DIERR
  1. ;
  1. I DDSBK=+$P(DDSBK,"E") D Q
  1. . I $D(^DIST(.404,DDSBK,0))[0 D BLD^DIALOG(3051,"#"_DDSBK) Q
  1. . S DDP=+$P(^DIST(.404,DDSBK,0),U,2)
  1. I DDSBK?1"["1.E1"]" D Q
  1. . N X,Y,DIC
  1. . S X=$E(DDSBK,2,$L(DDSBK)-1),DIC="^DIST(.404,",DIC(0)="FZ"
  1. . D ^DIC I Y<0 D BLD^DIALOG(3051,"named "_X) Q
  1. . S DDSBK=+Y,DDP=+$P(Y(0),U,2)
  1. D BLD^DIALOG(3051,"#"_DDSBK)
  1. Q
  1. ;
  1. GDA(DDS1B,DDS1E,DA) ;Find new DA
  1. ;Input:
  1. ; DDS1B = Block number
  1. ; DDS1E = 1:Interactive lookup
  1. ; DDSDAORG = Original DA array
  1. ; DDSDLORG = Original DL
  1. ; DDSPG
  1. ;Returns:
  1. ; DA = Record number
  1. ; DIERR
  1. ;
  1. N DDSDA,DDSI,X
  1. ;
  1. ;Set DA array to its original value
  1. S DA=DDSDAORG
  1. F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI)
  1. D DDSDA(.DA,DDSDLORG,.DDSDA)
  1. ;
  1. ;Xecute each PTB node
  1. F DDSI=1:1 Q:DA=""!'$D(@DDSREFS@(DDSPG,DDS1B,"PTB",DDSI)) X ^(DDSI) S:$G(X)'>0 DA=""
  1. ;
  1. ;Kill descendants of DA
  1. I '$G(DIERR) S DDSI=DA K DA S DA=DDSI
  1. S:DA'>0!$G(DIERR) DA=""
  1. Q
  1. ;
  1. GL(F,DA,DIE,DL,DDSDA,DDSL) ;Get global root, level, and IEN
  1. ;Input variables:
  1. ; F = file #
  1. ; DA = array
  1. ; DDSL = flag to lock record
  1. ;Returns:
  1. ; DIE = global root of file (null if error)
  1. ; DL = level (top=0) (null if error)
  1. ; DDSDA = IEN
  1. ; DIERR = Error flag
  1. ;
  1. I '$D(^DD(F)) D BLD^DIALOG(401,F) S (DIE,DL)="" Q
  1. I $D(^DIC(F,0,"GL"))#2 S DIE=^("GL"),DL=0
  1. E D SUBGL Q:$G(DIERR)
  1. ;
  1. I '$G(DA) S DDSDA="0," Q
  1. D DDSDA(.DA,DL,.DDSDA)
  1. ;
  1. N DDSP S DDSP("FILE")=F,DDSP("IEN")=DDSDA
  1. ;
  1. I $D(@(DIE_DA_",0)"))[0 D BLD^DIALOG(601,"",.DDSP)
  1. I $D(@(DIE_DA_",-9)")) D BLD^DIALOG(602,"",.DDSP)
  1. ;
  1. I $G(DDSL),$D(^TMP("DDS",$J,"LOCK",DIE_DA_")"))[0 D Q:$G(DIERR)
  1. . D LOCK^DILF(DIE_DA_")") E D BLD^DIALOG(110,"",.DDSP) Q ;**147
  1. . S ^TMP("DDS",$J,"LOCK",DIE_DA_")")=""
  1. Q
  1. ;
  1. SUBGL ;Get root and level for subfile
  1. N D,I,S,U1
  1. S D=F
  1. F DL=0:1 Q:$D(^DD(D,0,"UP"))[0 S U1=^("UP") G:'$D(^DD(U1,"SB",D)) SUBER G:$D(^DD(U1,$O(^(D,"")),0))[0 SUBER S S(DL+1)=""""_$P($P(^(0),U,4),";")_"""",D=U1
  1. G:$D(^DIC(D,0,"GL"))[0 SUBER S DIE=^("GL")
  1. F I=DL:-1:1 G:$D(DA(I))[0 SUBER S DIE=DIE_DA(I)_","_S(I)_","
  1. Q
  1. ;
  1. SUBER ;Come here if an error is encountered in GL
  1. S (DIE,DL)=""
  1. D BLD^DIALOG(309)
  1. Q
  1. ;
  1. DDSDA(DA,DL,DDSDA) ;Determine DDSDA
  1. ;Input:
  1. ; DA = Record array
  1. ; DL = Level number (top=0)
  1. ;Output:
  1. ; DDSDA = DA,DA(1),...,
  1. ;
  1. N I
  1. I DA="" S DDSDA="" Q
  1. S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
  1. Q