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

DDSVALF.m

Go to the documentation of this file. 
  1. DDSVALF ;SFISC/MKO-GET,PUT VALUES FOR FORM ONLY FIELDS ;11:30 AM  19 Apr 1999 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**8**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. GET(DDSVFD,DDSVBK,DDSVPG,DDSPARM,DDSVDA) ;Get value
  1.  ;In:  DDSPG = Current page
  1.  ;     DDSBK = Current block
  1.  ;     DDSPARM = "I" : internal, "E" : external form
  1.  ;
  1.  N DDSANS,DDSFLD,DDSVDDP,DIERR
  1.  I $D(DDSPG)[0 N DDSPG S DDSPG=0
  1.  I $D(DDSBK)[0 N DDSBK S DDSBK=0
  1.  S DDSANS=""
  1.  I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"I"
  1.  ;
  1.  S DDSFLD=$P($$GETFLD^DDSLIB($G(DDSVFD),$G(DDSVBK),$G(DDSVPG),DDS,$G(DDSPG),$G(DDSBK),"F"),",",1,2)
  1.  G:$G(DIERR) GETQ
  1.  ;
  1.  S DDSVFD=+DDSFLD,DDSVBK=+$P(DDSFLD,",",2)
  1.  ;
  1.  S DDSVDDP=+$P($G(^DIST(.404,DDSVBK,0)),U,2)
  1.  I DDSVDDP,$G(DDSVDA)]"" N DDSDA D
  1.  . I DDSVDA'["," S DDSVDA=$$IENS^DILF(.DDSVDA)
  1.  . E  S:DDSVDA'?.E1"," DDSVDA=DDSVDA_","
  1.  . S DDSDA=DDSVDA
  1.  E  I DDSVDDP,DDSVBK'=DDSBK N DDSDA D GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
  1.  ;
  1.  I $D(@DDSREFT@("F0",DDSDA,DDSFLD,"D"))#2 S DDSANS=^("D") S:DDSPARM["E"&($D(^("X"))#2) DDSANS=^("X") G GETQ
  1.  ;
  1.  I "013"[$P(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3) D BLD^DIALOG(520,"DD or caption-only") G GETQ
  1.  ;
  1.  ;Form-only fields
  1.  I $P($G(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=2 D  G:$G(DIERR) GETQ
  1.  . I $P($G(^DIST(.404,DDSVBK,40,DDSVFD,20)),U)="" D  Q
  1.  .. N P S P(1)="READ TYPE",P(2)="FIELD multiple of the BLOCK"
  1.  .. D BLD^DIALOG(3011,.P)
  1.  . D:$D(^DIST(.404,DDSVBK,40,DDSVFD,3))#2 DEF(^(3),$G(^(3.1)),.DDSANS)
  1.  . S (@DDSREFT@("F0",DDSDA,DDSFLD,"D"),^("O"))=DDSANS
  1.  . I DDSANS]"" D
  1.  .. D:$D(DDSANS(0))
  1.  ... S @DDSREFT@("F0",DDSDA,DDSFLD,"X")=$G(DDSANS(0,0),DDSANS(0))
  1.  ... S:DDSPARM["E" DDSANS=$G(DDSANS(0,0),DDSANS(0))
  1.  .. S $P(@DDSREFT@("F0",DDSDA,DDSFLD,"F"),U)=3,DDSCHG=1
  1.  ;
  1.  ;Computed fields
  1.  E  S:$P($G(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=4 DDSANS=$$VAL^DDSCOMP(DDSVFD,DDSVBK,DDSDA)
  1.  ;
  1. GETQ D:$G(DIERR) ERR^DDSVALM("$$GET^DDSVALF")
  1.  Q DDSANS
  1.  ;
  1. PUT(DDSVFD,DDSVBK,DDSVPG,DDSVAL,DDSPARM,DDSVDA) ;Put value
  1.  N DIR,X,Y
  1.  N DDER,DDSFLD,DDSVDDP,DDSVX,DIERR
  1.  I $D(DDSPG)[0 N DDSPG S DDSPG=0
  1.  I $D(DDSBK)[0 N DDSBK S DDSBK=0
  1.  S:$D(DDSVAL)[0 DDSVAL=""
  1.  I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"E"
  1.  ;
  1.  S DDSFLD=$$GETFLD^DDSLIB($G(DDSVFD),$G(DDSVBK),$G(DDSVPG),DDS,DDSPG,DDSBK,"F")
  1.  G:$G(DIERR) PUTQ
  1.  S DDSVFD=+DDSFLD,DDSVBK=+$P(DDSFLD,",",2),DDSVPG=$P(DDSFLD,",",3)
  1.  S DDSFLD=$P(DDSFLD,",",1,2)
  1.  ;
  1.  S DDSVDDP=+$P($G(^DIST(.404,DDSVBK,0)),U,2)
  1.  I DDSVDDP,$G(DDSVDA)]"" N DDSDA D
  1.  . I DDSVDA'["," S DDSVDA=$$IENS^DILF(.DDSVDA)
  1.  . E  S:DDSVDA'?.E1"," DDSVDA=DDSVDA_","
  1.  . S DDSDA=DDSVDA
  1.  E  I DDSVDDP,DDSVBK'=DDSBK N DDSDA D GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
  1.  ;
  1.  I $P(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3)'=2 D BLD^DIALOG(520,"DD, computed, or caption-only") G PUTQ
  1.  ;
  1.  S DIR(0)=$P(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$P(^(20),U,2,3)
  1.  I DDSPARM["I",$E(DIR(0))="P"!(DIR(0)?1"DD".E) D
  1.  . N FIL,FILROOT,FLD
  1.  . S Y=DDSVAL
  1.  . I $E(DIR(0))="P" D
  1.  .. S FIL=$P($P(DIR(0),U,2),":")
  1.  .. I 'FIL S FILROOT=U_FIL,FIL=+$P($G(@(U_FIL_"0)")),U,2) Q:'FIL
  1.  .. E  S FILROOT=$G(^DIC(FIL,0,"GL")) Q:FILROOT=""
  1.  .. S Y(0)=$P($G(@(FILROOT_Y_",0)")),U)
  1.  .. S Y(0)=$$EXTERNAL^DILFD(FIL,.01,"",Y(0))
  1.  . E  D
  1.  .. N DV,I S FIL=$P($P(DIR(0),","),U,2),FLD=$P(DIR(0),",",2)
  1.  .. S DV=$P($G(^DD(FIL,FLD,0)),U,2)
  1.  .. F I="O","P","V","D","S" I DV[I S Y(0)=$$EXTERNAL^DILFD(FIL,FLD,"",Y) Q
  1.  E  D  G:$G(DDER) PUTQ
  1.  . I DDSVAL="" D  Q
  1.  .. N DDSVREQ
  1.  .. S DDSVREQ=$P($G(@DDSREFT@(DDSVPG,DDSVBK,DDSVFD)),U)
  1.  .. S:DDSVREQ]"" DDSVREQ=$P($G(^DIST(.404,DDSVBK,40,DDSVFD,4)),U)
  1.  .. I DDSVREQ S DDER=1
  1.  .. E  S Y=""
  1.  . S DIR("V")="",(X,DIR("B"))=DDSVAL
  1.  . S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
  1.  . I $P(DIR(0),U)["P",$P($P(DIR(0),U,2),":",2)'["Z" D
  1.  .. N I
  1.  .. S I=$P(DIR(0),U,2) Q:$P(I,":",2)["Z"
  1.  .. S $P(I,":",2)=$P(I,":",2)_"Z"
  1.  .. S $P(DIR(0),U,2)=I
  1.  . D ^DIR
  1.  . I $E($P(DIR(0),U))="P" S Y=$P(Y,U)
  1.  ;
  1.  ;Update ^TMP
  1.  S DDSCHG=1
  1.  S (DDSVX,@DDSREFT@("F0",DDSDA,DDSFLD,"D"))=Y,^("F")=3 S:$D(Y(0))#2 (DDSVX,^("X"))=$S($D(Y(0,0))#2:Y(0,0),1:Y(0)) I $D(^("X"))#2,Y="" S (DDSVX,^("X"))=""
  1.  ;
  1.  ;Repaint field if it appears on the current page
  1.  I $D(@DDSREFS@("F0",DDSFLD,"L",DDSPG,DDSVBK,DDSVFD))#2 D
  1.  . N DY,DX,DDSVL,DDSVRJ,DDSX,DDSVREP
  1.  . S DDSVREP=$P($G(@DDSREFS@(DDSPG,DDSVBK)),U,7)
  1.  . S DY=+@DDSREFS@(DDSPG,DDSVBK,DDSVFD,"D"),DX=$P(^("D"),U,2),DDSVL=$P(^("D"),U,3),DDSVRJ=$P(^("D"),U,10)
  1.  . I $G(DDSVREP) D  Q:DY=""
  1.  .. N DDSVSN,DDSVPDA,DDSVOFS
  1.  .. S DDSVPDA=$G(@DDSREFT@(DDSPG,DDSVBK)) I 'DDSVPDA S DY="" Q
  1.  .. S DDSVREP=$P($G(@DDSREFT@(DDSPG,DDSVBK,DDSVPDA)),U,2,999) I DDSVREP="" S DY="" Q
  1.  .. S DDSVSN=$G(@DDSREFT@(DDSPG,DDSVBK,DDSVPDA,"B",DDSDA)) I 'DDSVSN S DY="" Q
  1.  .. S DDSVOFS=DDSVSN-$P(DDSVREP,U,2)
  1.  .. I DDSVOFS'<0,DDSVOFS<$P(DDSVREP,U,5) S DY=DY+DDSVOFS
  1.  .. E  S DY=""
  1.  . S DDSX=$P(DDGLVID,DDGLDEL)_$E(DDSVX,1,DDSVL)_$P(DDGLVID,DDGLDEL,10)
  1.  . X IOXY
  1.  . W $S(DDSVRJ:$J("",DDSVL-$L(DDSVX))_DDSX,1:DDSX_$J("",DDSVL-$L(DDSVX)))
  1.  ;
  1.  D
  1.  . N DDP,DDSDA S DDP=0,DDSDA="0,"
  1.  . D:$D(@DDSREFS@("PT",DDP,DDSFLD)) RPB^DDS7(DDP,DDSFLD,DDSPG)
  1.  . D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF^DDSCOMP(DDSPG)
  1.  ;
  1. PUTQ D:$G(DIERR) ERR^DDSVALM("PUT^DDSVALF")
  1.  Q
  1.  ;
  1. DEF(DDSLN3,DDSLN31,Y) ;Get default
  1.  N DDER,DIR,X
  1.  Q:DDSLN3=""
  1.  ;
  1.  I DDSLN3'="!M" S Y=DDSLN3
  1.  E  I DDSLN31'?."^" X DDSLN31 S:$D(Y)[0 Y=""
  1.  Q:Y=""
  1.  ;
  1.  S DIR(0)=$P(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$P(^(20),U,2,3)
  1.  S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
  1.  S DIR("V")="",(X,DIR("B"))=Y
  1.  D ^DIR I DDER K Y S Y=""
  1.  ;
  1.  I Y]"",$E($P(DIR(0),U))="P" S Y=$P(Y,U)
  1.  Q
  1.  ;