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

DDSVAL.m

Go to the documentation of this file.
  1. DDSVAL ;SFISC/MKO-GET,PUT FOR DD IELDS ;2OCT2003
  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. GET(DDSFILE,DA,DDSFLD,DDSER,DDSPARM) ;Get value for file/field
  1. N DDP,DIE,DDSANS,DDSTMP,X
  1. N DDSVDA,DDSVDDL0,DDSVDL,DDSVDV,DDSVND,DDSVPC,DIERR
  1. ;
  1. S DDSANS=""
  1. I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"I"
  1. ;
  1. D GDIE() G:$G(DIERR) GETQ G:'$G(DDSVDA) GETQ
  1. ;
  1. I DDSFLD[":",$$FIND^DDSLIB(DDSFLD,":") D G GETQ
  1. . S DDSANS=$$REL^DDSVALM(DDP,.DA,DDSFLD,DDSPARM)
  1. ;
  1. S DDSFLD=$$FIELD(DDP,DDSFLD) G:$G(DIERR) GETQ
  1. ;
  1. S:$D(DDSREFT)#2 DDSTMP=$NA(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD))
  1. I $D(DDS),$D(DDSREFT)#2,$D(@DDSTMP@("D")) D
  1. . I $D(@DDSTMP@("M")),'^("M") D Q
  1. .. S DDSANS=$NA(^TMP("DDSWP",$J,DDP,DDSVDA,DDSFLD))
  1. .. M @DDSANS=@DDSTMP@("D")
  1. . S DDSANS=$G(@DDSTMP@("D")) I DDSPARM["E",$D(^("X"))#2 S DDSANS=^("X")
  1. E D
  1. . D GNDPC Q:$G(DIERR)
  1. . I DDSVPC=0,DDSVDV["W" D GETWP^DDSVALM Q
  1. . S DDSANS=$$GVAL(DIE,DA,DDSVND,DDSVPC)
  1. . I DDSPARM["E" S DDSANS=$$EXTERNAL^DILFD(DDP,DDSFLD,"",DDSANS)
  1. ;
  1. GETQ D:$G(DIERR) ERR^DDSVALM("$$GET^DDSVAL")
  1. Q DDSANS
  1. ;
  1. PUT(DDSFILE,DA,DDSFLD,DDSVAL,DDSER,DDSPARM) ;Put value for file/field
  1. N DDP,DDSVDA,DDSV0,DDSV02,DDSVDL,DIE
  1. N DIERR
  1. ;
  1. S:$D(DDSVAL)[0 DDSVAL=""
  1. I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"E"
  1. ;
  1. D GDIE($D(DDS)#2) G:$G(DIERR) PUTQ G:'$G(DDSVDA) PUTQ
  1. S DDSFLD=$$FIELD(DDP,DDSFLD) G:$G(DIERR) PUTQ
  1. I DDSFLD=.01,"@"[DDSVAL D BLD^DIALOG(3086) G PUTQ
  1. ;
  1. S DDSV0=^DD(DDP,DDSFLD,0),DDSV02=$P(DDSV0,U,2)
  1. I +DDSV02 D
  1. . D MULT^DDSVALM
  1. E D VALPUT
  1. ;
  1. PUTQ D:$G(DIERR) ERR^DDSVALM("PUT^DDSVAL")
  1. Q
  1. ;
  1. VALPUT ;Validate and put
  1. N DDSVY
  1. I DDSPARM["E" D
  1. . D VAL^DIE(DDP,DDSVDA,DDSFLD,"ER",DDSVAL,.DDSVY)
  1. E D
  1. . D AUXVAL^DIEV(DDP,DDSVDA,DDSFLD,"EIR",DDSVAL,.DDSVY,DDSV0,DDSV02)
  1. Q:$G(DIERR)
  1. I DDSVY=DDSVY(0),'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD,"X")) K DDSVY(0)
  1. ;
  1. I $D(DDS) D
  1. . S:'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD)) ^("GL")=DIE
  1. . D UPDATE(DDP,DDSVDA,.DA,DDSFLD,DDSPG,.DDSVY)
  1. . S DDSCHG=1
  1. E D
  1. . N DDSFDA
  1. . S DDSFDA(DDP,DDSVDA,DDSFLD)=DDSVY
  1. . D FILE^DIE("","DDSFDA")
  1. Q
  1. ;
  1. UPDATE(DDP,DDSVDA,DA,FLD,PG,Y) ;Store value, repaint
  1. N DX,DY,BK,DDO,LEN,EXT,PAGE,RJ,REP,VAL
  1. S (EXT,@DDSREFT@("F"_DDP,DDSVDA,FLD,"D"))=Y,^("F")=3 S:$D(Y(0))#2 (EXT,^("X"))=Y(0)
  1. ;
  1. D:FLD=.01
  1. . S PAGE=0 F S PAGE=$O(@DDSREFS@("F"_DDP,FLD,"L",PAGE)) Q:'PAGE D
  1. .. S BK=0 F S BK=$O(@DDSREFS@("F"_DDP,FLD,"L",PAGE,BK)) Q:'BK D
  1. ... D:$P($G(@DDSREFS@(PAGE,BK)),U,8)
  1. .... N DDSPTB S DDSPTB=$G(@DDSREFS@(PAGE,BK,"PTB"))
  1. .... D:DDSPTB]"" RPF^DDS7(DDP,DDSPTB,DDSVDA,.DA)
  1. ;
  1. S BK=0 F S BK=$O(@DDSREFS@("F"_DDP,FLD,"L",PG,BK)) Q:'BK D
  1. . S DDO=0 F S DDO=$O(@DDSREFS@("F"_DDP,FLD,"L",PG,BK,DDO)) Q:'DDO D
  1. .. S LEN=$G(@DDSREFS@(PG,BK,DDO,"D")) Q:LEN=""
  1. .. S DY=+LEN,DX=$P(LEN,U,2),RJ=$P(LEN,U,10),LEN=$P(LEN,U,3)
  1. .. S REP=$P($G(@DDSREFS@(PG,BK)),U,7)
  1. .. I $G(REP) D Q:DY=""
  1. ... N SN,PDA,OFS
  1. ... S PDA=$G(@DDSREFT@(PG,BK)) I 'PDA S DY="" Q
  1. ... S REP=$P($G(@DDSREFT@(PG,BK,PDA)),U,2,999) I REP="" S DY="" Q
  1. ... S SN=$G(@DDSREFT@(PG,BK,PDA,"B",DDSVDA)) I 'SN S DY="" Q
  1. HITE ... N HITE S HITE=$$HITE^DDSR(BK),OFS=SN-$P(REP,U,2)*HITE ;DJW/GFT
  1. ... I OFS'<0,$P(REP,U,5)*HITE>OFS S DY=DY+OFS ;GFT OFFSET CAN'T BE OUTSIDE SCROLLING WINDOW
  1. ... E S DY=""
  1. .. S VAL=$P(DDGLVID,DDGLDEL)_$E(EXT,1,LEN)_$P(DDGLVID,DDGLDEL,10)
  1. .. X IOXY
  1. .. W $S(RJ:$J("",LEN-$L(EXT))_VAL,1:VAL_$J("",LEN-$L(EXT)))
  1. ;
  1. D:$D(@DDSREFS@("PT",DDP,FLD)) RPB^DDS7(DDP,FLD,PG)
  1. D:$D(@DDSREFS@("COMP",DDP,FLD,PG)) RPCF^DDSCOMP(PG)
  1. Q
  1. ;
  1. GDIE(DDSVL) ;In:
  1. ; DDSFILE = File # or root
  1. ; DA = Record array
  1. ; DDSVL = Flag to lock record
  1. ;Returns:
  1. ; DIE = Global root of file
  1. ; DDP = File #
  1. ; DDSVDL = Level #
  1. ; DDSVDA = DA,DA(1),...,
  1. S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
  1. I DDP=0 D BLD^DIALOG(202,"file") Q
  1. D GL^DDS10(DDP,.DA,.DIE,.DDSVDL,.DDSVDA,$G(DDSVL))
  1. Q
  1. ;
  1. GNDPC ;In:
  1. ; DDP = File #
  1. ; DDSFLD = Field #
  1. ;Returns:
  1. ; DDSVDDL0 = 0 node of DD
  1. ; DDSVND = Node where data resides
  1. ; DDSVPC = Piece where data resides
  1. ; DDSVDV = Field specifications
  1. ; X = Pointed to file root or set of codes
  1. I $G(DDSFLD)="" D BLD^DIALOG(202,"field") Q
  1. S DDSVDDL0=$G(^DD(DDP,DDSFLD,0))
  1. I DDSVDDL0?."^" D Q
  1. . N I,E
  1. . S (I("FILE"),E("FILE"))=DDP,I(1)="#"_DDSFLD,E("FIELD")=DDSFLD
  1. . D BLD^DIALOG(501,.I,.E)
  1. ;
  1. S DDSVPC=$P(DDSVDDL0,U,4)
  1. S DDSVND=$P(DDSVPC,";"),DDSVPC=$P(DDSVPC,";",2)
  1. S DDSVDV=$P(DDSVDDL0,U,2),X=$P(DDSVDDL0,U,3)
  1. ;
  1. N P S P("FILE")=DDP,P("FIELD")=DDSFLD
  1. I DDSVPC=" " D
  1. . D BLD^DIALOG(520,"computed",.P)
  1. I DDSVPC=0 D
  1. . S DDSVDV=+DDSVDV_$P($G(^DD(+DDSVDV,.01,0)),U,2)
  1. . D:DDSVDV'["W" BLD^DIALOG(520,"multiple",.P)
  1. Q
  1. ;
  1. GVAL(DIE,DA,ND,PC) ;Get value
  1. N LN,Y
  1. S LN=$G(@(DIE_"DA,ND)"))
  1. I $E(PC)'="E" S Y=$P(LN,U,PC)
  1. E S Y=$E(LN,+$E(PC,2,999),$P(PC,",",2)) S:Y?." " Y=""
  1. Q Y
  1. ;
  1. FIELD(DDP,FLD) ;Get field number
  1. N F,P
  1. S:$E(FLD)="""" FLD=$$UQT^DDSLIB($E(FLD,1,$$AFTQ^DDSLIB(FLD)-1))
  1. ;
  1. S F=FLD,P("FILE")=DDP
  1. I FLD'=+$P(FLD,"E") D Q:$G(DIERR) ""
  1. . S F=$O(^DD(DDP,"B",FLD,""))
  1. . I F="" S P(1)=FLD D BLD^DIALOG(501,.P)
  1. ;
  1. I $D(^DD(DDP,F,0))[0 S P(1)="#"_F D BLD^DIALOG(501,.P) Q ""
  1. Q F