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

DDS4.m

Go to the documentation of this file. 
  1. DDS4 ;SFISC/MKO-FILE AND RELOAD ;21SEP2006
  1.  ;;22.0;VA FileMan;**11,151**;Mar 30, 1999;Build 10
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  D ^DDS41 Q:Y'=1
  1.  N DA,DDO,DIE,DDP,DDSDA
  1.  ;
  1.  S DX=0,DY=IOSL-1 X IOXY W "Filing form"_$P(DDGLCLR,DDGLDEL)
  1.  ;
  1.  ;File data
  1.  S DDS4FI="F"
  1.  F  S DDS4FI=$O(@DDSREFT@(DDS4FI)) Q:DDS4FI'?1"F".E  D
  1.  . S DDP=$E(DDS4FI,2,999),DDS4DA=" "
  1.  . F  S DDS4DA=$O(@DDSREFT@(DDS4FI,DDS4DA)) Q:DDS4DA=""  D REC
  1.  ;
  1.  ;Reload all pages on form
  1.  S DDS4P=0
  1.  F  S DDS4P=$O(@DDSREFT@(DDS4P)) Q:'DDS4P  D
  1.  . S DDS4B=0
  1.  . F  S DDS4B=$O(@DDSREFT@(DDS4P,DDS4B)) Q:'DDS4B  D
  1.  .. S DDP=$P(@DDSREFS@(DDS4P,DDS4B),U,3),DDSDA=" "
  1.  .. F  S DDSDA=$O(@DDSREFT@(DDS4P,DDS4B,DDSDA)) Q:'DDSDA  D
  1.  ... S $P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U)=1,DIE=^(DDSDA,"GL")
  1.  ... Q:$P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U,6)>1
  1.  ... D GDA(DDSDA)
  1.  ... D ^DDS11(DDS4B,1)
  1.  ;
  1.  I $G(^DIST(.403,+DDS,14))'?."^" D
  1.  . I $G(DDSPTB)_$G(DDSREP)]"" N DIE,DDP,DDSDA,DA,DDSDL D
  1.  .. S DA=DDSDAORG,DDSDL=DDSDLORG,DDSDA=DA_","
  1.  .. F DDSI=1:1:DDSDL S DA(DDSI)=DDSDAORG(DDSI),DDSDA=DDSDA_DA(DDSI)_","
  1.  .. S DDP=$P($G(DDSFLORG),U),DIE=U_$P($G(DDSFLORG),U,2) S:DIE=U DIE=""
  1.  . X ^DIST(.403,+DDS,14)
  1.  I '$G(DDSSAVE),$G(DDSPARM)["S" S DDSSAVE=1
  1.  S (Y,DDSH)=1,(DDSCHG,DX)=0,DY=IOSL-1 X IOXY W $P(DDGLCLR,DDGLDEL)
  1.  K @DDSREFT@("ADD"),@DDSREFT@("RXR")
  1.  K DIC,DDS1B,DDS1DA,DDS4B,DDS4DA,DDS4FI,DDS4FLD,DDS4FO,DDS4P
  1.  K DDSEXT,DDSI,DDSINT,DDSLC,DDSLN,DDSND,DDSOND,DDSOLD,DDSP,DDSPC
  1.  K DDSW,DDSX,DV
  1.  Q
  1. REC ;
  1.  G:DDS4FI="F0" FORMONLY
  1.  ;
  1.  S DIE=$G(@DDSREFT@(DDS4FI,DDS4DA,"GL")) I DIE="" Q  ;JUST TO BE SAFE!
  1.  D GDA(DDS4DA)
  1.  S DDSOND=-1 K DDSLN
  1.  S DDS4FLD=""
  1.  F  S DDS4FLD=$O(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D FLD
  1.  S:$D(DDSLN)#2 @(DIE_"DA,DDSND)")=DDSLN
  1.  ;
  1.  I $D(@DDSREFT@("RXR")) D
  1.  . D FIRE^DIKC(DDP,.DA,"KS",$NA(@DDSREFT@("RXR")),"O^")
  1.  . K @DDSREFT@("RXR")
  1.  Q
  1. FLD ;
  1.  Q:'$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F"))  S ^("F")=""
  1.  I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
  1.  S DDSINT=$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
  1.  ;
  1.  ;Word processing fields (quit if multiple)
  1.  I $D(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"))#2 D:'$P(^("M"),U)  Q
  1.  . N FR,TO
  1.  . S FR=$NA(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
  1.  . S TO=U_$$CREF^DILF($P(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"),U,2))
  1.  . K @TO
  1.  . M @TO=@FR
  1.  . K @FR,@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F")
  1.  ;
  1.  Q:$G(^DD(DDP,DDS4FLD,0))?."^"  S DDSND=$P(^(0),U,4)
  1.  S DDSPC=$P(DDSND,";",2) Q:"0 "[DDSPC
  1.  S DDSND=$P(DDSND,";")
  1.  ;
  1.  I DDSOND'=DDSND D
  1.  . S:$D(DDSLN)#2 @(DIE_"DA,DDSOND)")=DDSLN
  1.  . S DDSLN=$G(@(DIE_"DA,DDSND)"))
  1.  . S DDSOND=DDSND
  1.  ;
  1.  I DDSPC D
  1.  . S DDSOLD=$P(DDSLN,U,DDSPC)
  1.  . S $P(DDSLN,U,DDSPC)=DDSINT
  1.  E  D
  1.  . S DDSW=$E(DDSPC,2,999),DDSP=$P(DDSW,",",2)+1
  1.  . S DDSOLD=$E(DDSLN,+DDSW,DDSP-1)
  1.  . S DDSX=$E(DDSLN,DDSP,999)
  1.  . S DDSLN=$E(DDSLN,1,DDSW-1)_$J("",DDSW-1-$L(DDSLN))_DDSINT
  1.  . S:DDSX'?." " DDSLN=DDSLN_$J("",DDSP-DDSW-$L(DDSINT))_DDSX
  1.  ;
  1.  I $D(^DD(DDP,DDS4FLD,1))!($P(^(0),U,2)["a")!$D(^DD("IX","F",DDP,DDS4FLD)) D XR
  1.  Q
  1. XR ;
  1.  N DICRREC,DG,DP,DDS4AUD1,DDS4AUD2,DIANUM,DIIX,C,Y
  1.  S DP=DDP,DDSOND=-1
  1.  I $D(DDSLN)#2 S @(DIE_"DA,DDSND)")=DDSLN K DDSLN
  1.  S DICRREC="TRIG^DDS4"
  1.  ;
  1.  I $P(^DD(DDP,DDS4FLD,0),U,2)["a" D
  1.  . S (DDS4AUD1,DDS4AUD2)=1
  1.  . I $G(^DD(DDP,DDS4FLD,"AUDIT"))["e",DDSOLD="" S DDS4AUD1=0
  1.  ;
  1.  I DDSOLD]"" D
  1.  . S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
  1.  .. S DIC=DIE,X=DDSOLD
  1.  .. X:$D(^DD(DDP,DDS4FLD,1,DG,2))#2 ^(2)
  1.  . I $G(DDS4AUD2) S DG=1,X=DDSOLD,DIIX="2^"_DDS4FLD D AUDIT^DIET
  1.  ;
  1.  I DDSINT]"" D
  1.  . S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
  1.  .. S DIC=DIE,X=DDSINT
  1.  .. X:$D(^DD(DDP,DDS4FLD,1,DG,1))#2 ^(1)
  1.  . I $G(DDS4AUD1) S DG=1,X=DDSINT,DIIX="3^"_DDS4FLD D AUDIT^DIET
  1.  Q:'$D(^DD("IX","F",DDP,DDS4FLD))
  1.  ;
  1.  ;Process index file xrefs
  1.  N DDSFXR,DDSFXREF,DDSRXREF
  1.  D LOADFLD^DIKC1(DDP,DDS4FLD,"KS","",$NA(@DDSREFT@("F"))_"_","DDSFXR",$NA(@DDSREFT@("RXR")),.DDSFXREF,.DDSRXREF)
  1.  I $G(DDSRXREF)]""!($G(DDSFXREF)]"") D
  1.  . S @DDSREFT@("F"_DDP,DDS4DA,DDS4FLD,"O")=DDSOLD ;BRX-0404-11337
  1.  D:$G(DDSFXREF)]"" FIRE^DIKC(DDP,.DA,"KS","DDSFXR","O^")
  1.  Q
  1. GDA(DDSDA) ;
  1.  N I
  1.  K DA S DA=$P(DDSDA,",")
  1.  F I=2:1:$L(DDSDA,",")-1 S DA(I-1)=$P(DDSDA,",",I)
  1.  Q
  1.  ;
  1. FORMONLY ;
  1.  N X
  1.  D GDA(DDS4DA)
  1.  S DDS4FLD=""
  1.  F  S DDS4FLD=$O(@DDSREFT@("F0",DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D
  1.  . Q:'$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"F"))
  1.  . S DDS4FO=$P(DDS4FLD,","),DDS4B=$P(DDS4FLD,",",2)
  1.  . S DDSOLD=$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"O")),X=$G(^("D")),DDSEXT=$G(^("X"),X)
  1.  . X:$G(^DIST(.404,DDS4B,40,DDS4FO,23))'?."^" ^(23)
  1.  . S ^("O")=@DDSREFT@("F0",DDS4DA,DDS4FLD,"D"),^("F")=""
  1.  Q
  1.  ;
  1. TRIG ;Called from trigger logic (from DICR via DICRREC)
  1.  N DDSRXREF
  1.  D LOADFLD^DIKC1(DIH,DIG,"KS","",$NA(@DDSREFT@("F"))_"_","",$NA(@DDSREFT@("RXR")),"",.DDSRXREF)
  1.  I $G(DDSRXREF)]"",'$D(@DDSREFT@("F"_DIH,DICRIENS,DIG,"O")) S ^("O")=DIU
  1.  Q