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

DDSVALM.m

Go to the documentation of this file.
  1. DDSVALM ;SFISC/MKO-PUT FOR MULTIPLES (SELECT PROMPT) ;10:45 AM 9 Sep 1994
  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. MULT ;Put multiple or wp field
  1. N DDSVDIC,DDSVDV,DDSVND,DDSVPC,DDSVSUB
  1. S DDSVPC=$P(DDSV0,U,4),DDSVND=$P(DDSVPC,";"),DDSVPC=$P(DDSVPC,";",2)
  1. S DDSVSUB=+DDSV02 Q:$D(^DD(DDSVSUB,.01,0))[0
  1. S DDSVDV=DDSVSUB_$P(^DD(DDSVSUB,.01,0),U,2),X=$P(^(0),U,3)
  1. S DDSVDIC=DIE_DA_","""_DDSVND_""","
  1. ;
  1. I DDSVDV["W" D PUTWP
  1. I DDSVDV'["W" D PUTMULT
  1. Q
  1. ;
  1. PUTMULT ;Put for multiples
  1. N DDSVRN
  1. S DDSVRN=$S(DDSVAL="FIRST":$O(@(DDSVDIC_"0)")),DDSVAL="LAST":$O(@(DDSVDIC_""" "")"),-1),1:+$G(DDSVAL))
  1. ;
  1. K Y S Y="",Y(0)=""
  1. I DDSVRN>0,$D(@(DDSVDIC_+DDSVRN_",0)"))#2 S Y(0)=$P(^(0),U) D
  1. . I DDSVDV["O"!(DDSVDV["P")!(DDSVDV["V")!(DDSVDV["D")!(DDSVDV["S") D
  1. .. S Y(0)=$$EXTERNAL^DILFD(DDSVSUB,.01,"",DDSVRN)
  1. . S Y=DDSVRN
  1. ;
  1. S:'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD,"M")) ^("M")=1_DDSVDIC_U_DDSVSUB
  1. D UPDATE^DDSVAL(DDP,DDSVDA,.DA,DDSFLD,DDSPG,.Y)
  1. Q
  1. ;
  1. PUTWP ;File wp field from @DDSVAL into @DDSREFT
  1. N DDSTMP
  1. S DDSTMP=$NA(@DDSREFT@("F"_DDP,DDSDA))
  1. ;
  1. I DDSVAL]"",$D(@DDSVAL) D Q:$G(DIERR)
  1. . D PUTWP^DIEFW($E("A",DDSPARM["A"),DDSVAL,$NA(@DDSTMP@(DDSFLD,"D")))
  1. E K @DDSTMP@(DDSFLD,"D")
  1. ;
  1. S:$D(@DDSTMP@(DDSFLD,"M"))[0 ^("M")="0"_DDSVDIC_U_DDSVSUB
  1. S:$D(@DDSTMP@("GL"))[0 ^("GL")=DIE
  1. S (DDSCHG,@DDSTMP@(DDSFLD,"F"))=3
  1. Q
  1. ;
  1. GETWP ;Merge wp field into ^TMP, return root in DDSANS
  1. N DDSGL
  1. S DDSGL=DIE_DA_","""_DDSVND_""","
  1. S DDSANS=$NA(^TMP("DDSWP",$J,DDP,DDSDA,DDSFLD))
  1. ;
  1. K @DDSANS
  1. M:$D(@(DDSGL_"0)"))#2 @DDSANS=@($E(DDSGL,1,$L(DDSGL)-1)_")")
  1. Q
  1. ;
  1. REL(DDP,DA,DDSFLD,DDSPARM) ;Relational syntax
  1. N DDSCD,DDSI,X
  1. D DD^DDSPTR(DDP,DDSFLD,"",.DDSCD,"",DDSPARM["I"+1)
  1. F DDSI=1:1:DDSCD X DDSCD(DDSI)
  1. Q X
  1. ;
  1. ERR(DDSVEP) ;Print error messages
  1. Q:'$G(DIERR)
  1. I '$D(DDS) D MSG^DIALOG("BW") Q
  1. N DDSVMSG
  1. S DDSER=DIERR
  1. D BLD^DIALOG(3031,DDSVEP,"","DDSVMSG")
  1. D MSG^DDSMSG(DDSVMSG(1)),ERR^DDSMSG
  1. Q