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

DDS1.m

Go to the documentation of this file. 
  1. DDS1 ;SFISC/MKO - LOAD PAGE ;21MAR2017
  1.  ;;22.2;VA FileMan;**5**;Jan 05, 2016;Build 28
  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.  ;;GFT;**115,1003,1004,1028,1053,1057**
  1.  ;
  1.  ;Input:
  1.  ;  DDS     = Form number^Form name
  1.  ;  DDSPG   = Internal page number
  1.  ;  DA      = Record array
  1.  ;  DDSREFT = Global location where data (temporarily) is stored
  1.  ;  DDP     = Primary file number of form
  1.  ;  DIE     = Global root of form
  1.  ;  DDSDA   = DA,DA(1),... of form
  1.  ;  DDSDL   = Level number
  1.  ;Also needed for pointed-to blocks:
  1.  ;  DDSDAORG
  1.  ;  DDSDLORG
  1.  ;Returns:
  1.  ;  DIERR
  1.  ;
  1. EN(DDSPG,DDSAGAIN) ;entry point moved from 1st line.
  1.  ;
  1.  N DDS1B,DDS1BO K DDSMOUSE S U="^"
  1.  ;
  1.  ;Get header block
  1.  S DDS1B=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,2)
  1.  I DDS1B]"" D BLK(DDSPG,DDS1B,"",1) G:$G(DIERR) END
  1.  ;
  1.  ;Get all other blocks on page
  1.  S DDS1BO="" F  S DDS1BO=$O(^DIST(.403,+DDS,40,DDSPG,40,"AC",DDS1BO)) Q:DDS1BO=""  S DDS1B=$O(^(DDS1BO,0)) Q:'DDS1B  D BLK(DDSPG,DDS1B,DDS1BO) G:$G(DIERR) END
  1.  ;
  1. END K DDSMOUSE
  1.  Q
  1.  ;
  1. BLK(DDSPG,DDS1B,DDS1BO,DDS1H,DDS1E) ;Load block
  1.  ;In:  DDS1H  = 1 if a header block
  1.  ;     DDS1E  = 1 if we're loading up a pointed-to block and
  1.  ;              we want interactive dialog (DIC(0)["E") in the lookup
  1.  ;
  1.  I $D(^DIST(.404,DDS1B,0))[0 D BLD^DIALOG(3051,"#"_DDS1B) Q
  1.  ;
  1.  N DDS1PTB,DDS1REP S DDS1PTB=""
  1.  I '$G(DDS1H) D
  1.  . S DDS1PTB=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,1)),DDS1REP=$G(^(2))
  1.  . K:DDS1REP<2 DDS1REP
  1.  ;
  1.  I DDS1PTB]"" N @$$D0(DDSDL),DA,DDP,DIE,DDSDL,DDSDA D  Q:$G(DIERR)
  1.  . I $G(DDS1REP)>1 D
  1.  .. D BK^DDS10(.DDS1B,.DDP) Q:$G(DIERR)
  1.  .. D GDA^DDS10(DDS1B,$G(DDS1E),.DA) Q:$G(DIERR)
  1.  .. S DDP=$G(^DD(DDP,0,"UP"),DDP) ;GFT
  1.  .. D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1)
  1.  .. D GETD0(.DA,DDSDL)
  1.  . E  D
  1.  .. D SET^DDS10(DDS1B,$G(DDS1E),.DA,.DDP,.DIE,.DDSDL,.DDSDA) ;GO GET THE NEW 'DA' VALUE
  1.  .. I +$G(DIERR)=1,$G(^TMP("DIERR",$J,1))=601 D  Q
  1.  ... L -@(DIE_DA_")")
  1.  ... K ^TMP("DDS",$J,"LOCK",DIE_DA_")")
  1.  ... D CLEAN^DILF
  1.  ... S (DA,D0,DDSDA)=""
  1.  .. Q:$G(DIERR)
  1.  .. I DA="",'$G(DDS1E),$P($G(@DDSREFT@(DDSPG,DDS1B)),U)]"" S DDSDA=$P(^(DDS1B),U),DA=+DDSDA
  1.  .. S D0=DA
  1.  ;
  1.  I $G(DA)!'$G(DDSDAORG),$G(@DDSREFT@(DDSPG,DDS1B,DDSDA))<1 D
  1.  . S $P(@DDSREFT@(DDSPG,DDS1B,DDSDA),U)=1
  1.  . I $G(DDS1REP)>1 D REP Q
  1.  . ;
  1.  . S @DDSREFT@(DDSPG,DDS1B,DDSDA,"GL")=DIE
  1.  . D EN^DDS11(DDS1B)
  1.  ;
  1.  I '$G(DDSAGAIN)!'$D(@DDSREFT@(DDSPG,DDS1B)) S $P(@DDSREFT@(DDSPG,DDS1B),U)=$G(DDSDA)
  1.  Q
  1.  ;
  1. REP ;Load data for repeating block
  1.  N DDS1DDP,DDS1IND,DDS1INI,DDS1MUL,DDS1PDA,DDS1REF,DDS1RT,DDS1SEL
  1.  N DDS1SN,DDS1VAL,DDS1FSCR,DDS1SCNT,DDS1STRT,DDS1Q,DDS1ACT
  1.  S DDS1REF=$NA(@DDSREFT@(DDSPG,DDS1B))
  1.  S DDS1DDP=$P(@DDSREFS@(DDSPG,DDS1B),U,3)
  1.  S DDS1IND=$P(DDS1REP,U,2) S:DDS1IND="" DDS1IND="B"
  1.  S DDS1INI=$P(DDS1REP,U,3)
  1.  S DDS1SEL=$P(@DDSREFS@(DDSPG,DDS1B),U,10)
  1.  S DDS1PDA=DDSDA
  1.  ;
  1.  S DDS1MUL=$O(^DD(+DDP,"SB",DDS1DDP,""))
  1.  S:$G(^DD(DDS1DDP,0,"SCR"))]"" DDS1FSCR=^("SCR")
  1. ACT S:$G(^("ACT"))]"" DDS1ACT=^("ACT")
  1.  ;
  1.  S $P(@DDS1REF@(DDS1PDA),U,7,10)=DDP_U_DDS1MUL_U_DDS1SEL_U_DDS1IND
  1.  S @DDS1REF@(DDSDA,"GL")=$S(DDS1MUL:DIE_+DA_","""_$P($P(^DD(DDP,DDS1MUL,0),U,4),";")_""",",1:^DIC(DDS1DDP,0,"GL"))
  1.  ;
  1.  N DIE,DDP
  1.  S DIE=@DDS1REF@(DDSDA,"GL"),DDS1RT=$$CREF^DILF(DIE),DDP=DDS1DDP
  1.  S DDS1SN=0
  1.  ;
  1.  I DDS1MUL D  ;IT'S A MULTIPLE FIELD WITHIN TOP-LEVEL FILE
  1.  . D DDA^DDS5(0,.DA,.DDSDL)
  1.  . S DDSDA=","_DDSDA
  1.  . S:'$D(@DDS1RT@(DDS1IND)) DDS1IND="!IEN"
  1.  . I DDS1IND="!IEN" D
  1.  .. S DA=0 F  S DA=$O(@DDS1RT@(DA)) Q:'DA  D REPLD
  1.  . E  D
  1.  .. S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND)),DDS1SCNT=$QL(DDS1Q)
  1.  .. F  S DDS1Q=$Q(@DDS1Q) Q:DDS1Q=""  Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT  D
  1.  ... S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
  1.  ;
  1. GFT E  I $G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,"COMP MUL"))]"" D  S DDSDA=DDS1PDA,DA=+DDSDA,@DDS1REF@("COMP MUL")=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,"COMP MUL PTR")) ;COMPUTED MULTIPLE BUILDS A REPEATING BLOCK
  1.  .N DICMX,D
  1.  .I $G(^("COMP MUL PTR"))="" S DICMX="S DA=$G(D0,$G(D)) N D D NOFILE^DDS1"
  1.  .E  S DICMX="S DA=$G(D0,$G(D)) N D D REPLD^DDS1"
  1.  .X ^("COMP MUL")
  1.  ;
  1.  E  I $G(DA) S DDS1VAL=DA N D0,DA,DDSDA D  ;IT'S A RELATIONAL JUMP  (DA COULD BE UNDEFINED FOR AN UNRELATED FILE!)
  1.  . S DDSDA=","
  1.  . S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND,DDS1VAL)),DDS1SCNT=$QL(DDS1Q)
  1.  . F  S DDS1Q=$Q(@DDS1Q) Q:DDS1Q=""  Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT  D
  1.  .. S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
  1.  ;
  1.  E  S DIERR=1 Q
  1.  ;Now set INITIAL POSITION
  1. DISV I DDS1INI="u" S DDS1INI="l" I $G(DUZ)]"",$G(DIE)]"" D  I DDS1INI
  1.  .N T
  1.  .S T=$G(^DISV(DUZ,DIE)) Q:'T  S T=$G(@DDS1REF@(DDS1PDA,"B",T_",")) Q:'T  ;Get entry that SPACE-BAR would return
  1.  .S DDS1SN=T,T=T-DDS1REP+1
  1.  .I T>0 S DDS1INI=T_U_(DDS1SN-T+1)_U_DDS1SN Q
  1.  .S DDS1INI=1_U_DDS1SN_U_DDS1SN
  1.  E  I DDS1INI="l"!(DDS1INI="n") D
  1.  . N N,T
  1.  . S N=DDS1INI="n"
  1. F . S DDS1SN=$O(@DDS1REF@(DDS1PDA," "),-1)+N S:'DDS1SN DDS1SN=1 ;Don't want 1^0^0
  1.  . S T=DDS1SN-DDS1REP+2-N
  1.  . S DDS1INI=$S(T<1:1_U_DDS1SN,1:T_U_(DDS1REP-'N))_U_DDS1SN
  1.  E  S DDS1INI="1^1^1"
  1.  ;
  1.  S $P(@DDS1REF@(DDS1PDA),U,2,6)=DDS1PDA_U_DDS1INI_U_+DDS1REP
  1.  ;
  1.  I DDS1MUL D
  1.  . D UDA^DDS5(.DA,.DDSDL)
  1.  . S DDSDA=$P(DDSDA,",",2,999)
  1.  Q
  1.  ;
  1. REPLD ;Load data
  1.  Q:'$D(@DDS1RT@(DA,0))  I $D(DDS1FSCR) N Y S Y=DA X DDS1FSCR Q:'$T
  1.  I $D(DDS1ACT) D
  1.  .N DIC,Y
  1.  .S DIC(0)="E",Y=DA_U_$P(@DDS1RT@(DA,0),U)
  1.  .X DDS1ACT ;HERE IS WHERE ACCESS AUDITING WOULD TAKE PLACE IF IT IS SET UP IN POST-ACTION!
  1. NOFILE S DDS1SN=DDS1SN+1,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
  1.  S @DDS1REF@(DDS1PDA,DDS1SN)=DDSDA
  1.  S @DDS1REF@(DDS1PDA,"B",DDSDA)=DDS1SN
  1.  D EN^DDS11(DDS1B)
  1.  Q
  1.  ;
  1. D0(DL) ;Given DL, return string D0,D1,...,Dn
  1.  N I,S
  1.  S S="" F I=0:1:DL S S=S_"D"_I_","
  1.  S:S?.E1"," S=$E(S,1,$L(S)-1)
  1.  Q S
  1.  ;
  1. GETD0(DA,DL) ;Given DA array, set D0,D1...
  1.  N I
  1.  S @("D"_DL)=DA
  1.  F I=1:1:DL-1 S @("D"_(DL-I))=DA(I)
  1.  Q