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

DDS0.m

Go to the documentation of this file.
  1. DDS0 ;SFISC/MLH-SETUP, CLEANUP ;24FEB2004
  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. EN(DDSFILE,DR,DA) ;Initial setup
  1. S U="^"
  1. D INIT^DDGLIB0() Q:$G(DIERR)
  1. D FORM(.DDSFILE,DR) Q:$G(DIERR)
  1. ;
  1. ;Compile the form if not already compiled
  1. S DDSREFS=$$REF(DDS)
  1. I '$$COMPILED(DDS) D EN^DDSZ(DDS) Q:$G(DIERR)
  1. N:$P(^DIST(.403,+DDS,0),U,10) DA
  1. ;
  1. D FRSTPG(DDS,.DA,$G(DDSPAGE)) Q:$G(DIERR)
  1. D REC(DDP,.DA) Q:$G(DIERR)
  1. D INIT
  1. Q
  1. ;
  1. FORM(DDSFILE,DR) ;Form lookup
  1. ;Output:
  1. ; DDS = Form number^Form name
  1. ; DDP = File number (or 0)
  1. ; DDSPG = First page to go to on form
  1. ; DIERR
  1. ;
  1. I $D(DDSFILE)[0 D BLD^DIALOG(201,"DDSFILE") Q
  1. ;
  1. N DIC,X,Y
  1. ;
  1. S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
  1. S X=$S(DR:DR,1:$P($P(DR,"[",2),"]"))
  1. S DIC="^DIST(.403,",DIC(0)="FNX",D="F"_DDP
  1. D IX^DIC K DIC
  1. ;
  1. I Y<0 D BLD^DIALOG(3021,X) Q
  1. I '$O(^DIST(.403,+Y,40,"B","")) D BLD^DIALOG(3022,X) Q
  1. S DDS=Y
  1. ;
  1. I $D(DDSFILE(1))#2 S DDP=$S(DDSFILE(1)=+DDSFILE(1):DDSFILE(1),1:+$P($G(@(DDSFILE(1)_"0)")),U,2))
  1. Q
  1. ;
  1. FRSTPG(DDS,DA,DDSPAGE) ;Get first page of form
  1. ;Output:
  1. ; DDSPG
  1. ; DDSSEL = 1, if DA is null and there is a record selection page
  1. ; DIERR
  1. ;
  1. N P
  1. I $G(DA)!$P(^DIST(.403,+DDS,0),U,10) D
  1. . S P=$S($G(DDSPAGE):DDSPAGE,1:1)
  1. . S DDSPG=$O(^DIST(.403,+DDS,40,"B",P,""))
  1. . I $D(^DIST(.403,+DDS,40,+DDSPG,0))[0 D BLD^DIALOG(3023,"number "_P)
  1. E D PG^DDSRSEL D:'$G(DDSSEL) BLD^DIALOG(202,"record")
  1. Q
  1. ;
  1. REC(DDP,DA) ;Check record and lock
  1. ;Output:
  1. ; DIE = Global root
  1. ; DDSDA = DA,DA(1),...,
  1. ; DDSDAORG = Original DA array
  1. ; DDSDL = Level number (top=0)
  1. ; DDSDLORG = Original level number
  1. ; DDSFLORG = Orig DDP^Orig DIE
  1. ; D0,D1,etc.
  1. ; DIERR
  1. ;
  1. I '$G(DA) D Q
  1. . S DIE="",(DDSDL,DDSDLORG)=0,DDSDA="0,"
  1. . S DA="",DDSDAORG=DA
  1. ;
  1. D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,'$P(^DIST(.403,+DDS,0),U,9)) Q:$G(DIERR) ;Don't LOCK record if screen is DISPLAY-ONLY
  1. ;
  1. I $D(DIOVRD)[0 D Q:$G(DIERR)
  1. . N DDSTOP S DDSTOP=$$FNO^DILIBF(DDP)
  1. . Q:$P($G(^DD(DDSTOP,0,"DI")),U,2)'["Y"
  1. EGP . N P S P("FILE")=$$FILENAME^DIALOGZ(DDSTOP) ;**CCO/NI RESTRICTED FILE NAME
  1. . D BLD^DIALOG(405,DDSTOP,.P)
  1. ;
  1. S DDSDLORG=DDSDL
  1. K DDSDAORG S (DDSDAORG,@("D"_DDSDL))=DA
  1. F DDSI=1:1:DDSDL S (DDSDAORG(DDSI),@("D"_(DDSDL-DDSI)))=DA(DDSI)
  1. S DDSFLORG=$G(DDP)_$G(DIE)
  1. K DDSI
  1. Q
  1. ;
  1. INIT ;Initialize some variables
  1. ; DDSHBX = $Y of first line of help area
  1. ; DDSREFT = Global reference of temporary global location
  1. ; DDSFDO = 1 if entire form is display-only
  1. ; DDSCHG = Change flag
  1. ; DDSKM = Flag to keep whatever's in help area
  1. ; DDSH = Flag to indicate help area is empty
  1. ; DDSSC = Array to indicate what pages are on the screen
  1. ;
  1. DDSHBX S DDSHBX=17 I $G(DDS),$G(DDSPG),$D(DDSREFS) D
  1. .N % S %=$O(@DDSREFS@("X",DDSPG,""),-1)+1 I %>DDSHBX S DDSHBX=% ;LAST FIELD CAPTION
  1. .F DDH=0:0 S DDH=$O(@DDSREFS@(DDSPG,DDH)) Q:'DDH I $G(^(DDH)) S %=$P(^(DDH),U,7)+^(DDH) I %>DDSHBX S DDSHBX=%
  1. S DDXY=IOXY_" S $X=DX,$Y=DY"
  1. ;
  1. K DDH,DDSSC,DDSCHANG,DDSSAVE
  1. S DDSH=1,(DDH,DDM,DDSCHG,DDSSC)=0,DDACT="N"
  1. DDSREFT S DDSREFT=$NA(^TMP("DDS",$J,+DDS)) ;GFT
  1. K @DDSREFT
  1. MOUSEON I $G(DDS)>0 W *27,"[?1000h"
  1. N %,%H,%I,X
  1. D NOW^%DTC
  1. S $P(^DIST(.403,+DDS,0),U,6)=$E(%,1,12)
  1. Q
  1. ;
  1. END I $D(DDSHBX) S DX=0,DY=IOSL-1 X IOXY
  1. D KILL^DDGLIB0($G(DDSPARM))
  1. ;
  1. D:$D(^TMP("DDS",$J,"LOCK")) UNLOCK
  1. ;
  1. K:'$G(DA) DA
  1. I $D(DA),$D(DDSDAORG)#2,$D(DDSDLORG)#2 D
  1. . K DA,D0
  1. . S DA=DDSDAORG
  1. . F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI) K @("D"_DDSI)
  1. MOUSEOFF W *27,"[?1000l"
  1. K:$G(DDSPARM)'["E" DIERR,^TMP("DIERR",$J)
  1. K:$D(DDSREFT)#2 @DDSREFT,DDSREFT
  1. K ^TMP("DDSH",$J),^TMP("DDSWP",$J)
  1. K DDACT,DDH,DDM,DDO,DDP,DDQ,DDS,DDSDDP
  1. K DDSBK,DDSBR,DDSCHG,DDSDA,DDSDAORG,DDSDL
  1. K DDSDLORG,DDSDN,DDSEXT,DDSFDO,DDSFLD,DDSFLORG,DDSGL,DDSH,DDSI
  1. K DDSKM,DDSLN,DDSNP,DDSO,DDSOLD,DDSORD,DDSOPB,DDSOSV,DDSPTB,DDSPG
  1. K DDSPX,DDSPY,DDSQ,DDSREP,DDSSC,DDSSP,DDSSTACK,DDSTP,DDSU,DDSX
  1. K DDSHBX,DDSREFS,DDXY
  1. K DIC,DIR,DIR0N,DIROUT,DIRUT,DUOUT,DY,DX
  1. K A1,D,DDC,DDD,DI,DIEQ,DIK,DIW,DIY,DIZ,DS
  1. Q
  1. ;
  1. UNLOCK ;Unlock any lock records
  1. N I
  1. S I="" F S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I="" L -@I
  1. K ^TMP("DDS",$J,"LOCK")
  1. Q
  1. ;
  1. COMPILED(DDS) ;Return 1 if form is compiled
  1. Q $D(@$$REF(DDS))>0
  1. ;
  1. REF(DDS) ;Return global reference for compiled global
  1. Q $NA(^DIST(.403,+DDS,"AY"))
  1. ;
  1. OLDREF(DDS) ;Return global reference for compiled global used prior
  1. ;to version 22.0
  1. Q $NA(^DIST(.403,+DDS,"AZ"))
  1. ;
  1. IXF ;
  1. N D0,DA,DIC,DP,Y S DIC="^DD("_DDGFDD_",",DIC(0)="EN" D ^DIC
  1. I Y'>0 K X
  1. E S X=+$P(Y,"E")
  1. Q