Return to DDSUTL.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSUTL	;SFISC/MKO-PROGRAMMER UTILITIES ;03:36 PM  7 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: MSG(TXT)	;
    6: 	;Data validation messages
    7: 	D PROC(.TXT,$NA(@DDSREFT@("MSG")))
    8: 	Q
    9: 	;
   10: HLP(TXT)	;
   11: 	;Help box messages
   12: 	D PROC(.TXT,$NA(@DDSREFT@("HLP")))
   13: 	Q
   14: PROC(TXT,GLB)	;
   15: 	;Put text into global
   16: 	N CNT,I
   17: 	S CNT=$G(@GLB)
   18: 	I $D(TXT)<9 S CNT=CNT+1,@GLB@(CNT)=TXT
   19: 	E  S I="" F CNT=CNT:1 S I=$O(TXT(I)) Q:I=""  S @GLB@(CNT+1)=TXT(I)
   20: 	S @GLB=CNT
   21: 	Q
   22: 	;
   23: REFRESH	;Refresh the screen
   24: 	G R^DDSR
   25: 	;
   26: MLOAD(DDSIEN)	;Load subrecords for current multiple
   27: 	G MLOAD^DDSM1
   28: 	;
   29: MDEL(DDSIEN)	;Delete subrecords for current multiple
   30: 	G MDEL^DDSM1
   31: 	;
   32: UNED(DDSF,DDSB,DDSP,DDSVAL,DDSUDA)	;Change DISABLE EDITING attribute
   33: 	S:$D(DDSVAL)[0 DDSVAL=""
   34: 	D SETATT(4)
   35: 	Q
   36: 	;
   37: REQ(DDSF,DDSB,DDSP,DDSVAL,DDSUDA)	;Change REQUIRED attribute
   38: 	S:$D(DDSVAL)[0 DDSVAL=""
   39: 	D SETATT(1)
   40: 	Q
   41: 	;
   42: 	;
   43: SETATT(DDSUPC)	;Set attribute node, piece DDSUPC
   44: 	N DDSOVAL,DDSUDDP,DDSUFLD,DDSUTP
   45: 	I $D(DDSPG)[0 N DDSPG S DDSPG=""
   46: 	I $D(DDSBK)[0 N DDSBK S DDSBK=""
   47: 	S DDSP=$$GETFLD^DDSLIB(DDSF,$G(DDSB),$G(DDSP),+DDS,DDSPG,DDSBK)
   48: 	I $G(DIERR) D ERR^DDSMSG Q
   49: 	;
   50: 	S DDSF=$P(DDSP,","),DDSB=$P(DDSP,",",2),DDSP=$P(DDSP,",",3)
   51: 	;
   52: 	S DDSUDDP=+$P($G(^DIST(.404,DDSB,0)),U,2)
   53: 	I DDSUDDP,$G(DDSUDA)]"" N DDSDA S DDSDA=DDSUDA
   54: 	E  I DDSUDDP,DDSB'=DDSBK N DDSDA D GL^DDS10(DDSUDDP,.DDSDAORG,"","",.DDSDA)
   55: 	;
   56: 	S DDSUTP=$P($G(^DIST(.404,DDSB,40,DDSF,0)),U,3)
   57: 	I DDSUTP=2 D
   58: 	. S DDSUFLD=DDSF_","_DDSB
   59: 	. S DDSUDDP=0
   60: 	E  I DDSUTP=3 D  Q:'DDSUFLD
   61: 	. S DDSUFLD=$P($G(^DIST(.404,DDSB,40,DDSF,1)),U)
   62: 	E  Q
   63: 	;
   64: 	S DDSOVAL=$P($G(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A")),U,DDSUPC)
   65: 	Q:DDSVAL=DDSOVAL
   66: 	S $P(@DDSREFT@("F"_DDSUDDP,DDSDA,DDSUFLD,"A"),U,DDSUPC)=DDSVAL
   67: 	Q
   68: 	;
   69: ADD(DDSFIL,X,DA,DINUM,DDSDIC0,DDSDR,DDSL)	;
   70: 	;Add an entry as part of a transaction
   71: 	;DDSL=1 means don't lock
   72: 	;
   73: 	N %,%W,%Y,C,D0,DD,DO,DI,DIC,DIE,DQ,DR
   74: 	N DDSDA,DDSDIC,DDSFD,DDSREQ,DDSUP,I
   75: 	K DIERR,^TMP("DIERR",$J)
   76: 	K:'$G(DINUM) DINUM
   77: 	S:$G(DDSDIC0)="" DDSDIC0="L"
   78: 	S DIC(0)=DDSDIC0,Y=-1
   79: 	S:$G(DDSDR)]"" DIC("DR")=DDSDR
   80: 	S DIC=$$ROOT^DILFD(DDSFIL,.DA),DDSDIC=$$CREF^DIQGU(DIC)
   81: 	;
   82: 	I $D(@DDSDIC@(0))[0 D  Q:$G(DIC("P"))=""
   83: 	. S DDSUP=$G(^DD(DDSFIL,0,"UP")) Q:'DDSUP
   84: 	. S DDSFD=$O(^DD(DDSUP,"SB",DDSFIL,"")) Q:'DDSFD
   85: 	. S DIC("P")=$P($G(^DD(DDSUP,DDSFD,0)),U,2)
   86: 	;
   87: 	I DDSDIC0'["E",$$REQID(DDSFIL,.DDSREQ) D  Q:$G(DIERR)
   88: 	. N F
   89: 	. S F=""
   90: 	. F  S F=$O(DDSREQ(F)) Q:'F  I $G(DIC("DR"))'[(F_"///") D BLD^DIALOG(3031,"ADD^DDSUTL") Q
   91: 	;
   92: 	D FILE^DICN K DTOUT,DUOUT Q:Y=-1!'$D(DDS)
   93: 	;
   94: 	I '$G(DDSL) D
   95: 	. N I,L,R
   96: 	. S L=1,R=DIC_DA_","
   97: 	. F I=$L(R,",")-1:-1:1 I $D(^TMP("DDS",$J,"LOCK",$P(R,",",1,I)_")"))#2 S L=0 Q
   98: 	. I L,$D(^TMP("DDS",$J,"LOCK",$P(R,"(")))#2 S L=0
   99: 	. I L L +@(DIC_+Y_")"):0 S ^TMP("DDS",$J,"LOCK",DIC_+Y_")")=""
  100: 	;
  101: 	S DDSDA=+Y_","
  102: 	F I=1:1 Q:$D(DA(I))[0  S DDSDA=DDSDA_DA(I)_","
  103: 	S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIC
  104: 	Q
  105: 	;
  106: REQID(FIL,REQ)	;
  107: 	;Get list of required identifiers into DDSREQ
  108: 	N F
  109: 	K REQ
  110: 	S F="" F  S F=$O(^DD(FIL,0,"ID",F)) Q:F'=+$P(F,"E")  D
  111: 	. S:$P($G(^DD(FIL,F,0)),U,2)["R" REQ(F)=""
  112: 	Q $D(REQ)>0
  113: 	;
  114: DDSDA(DA,DL,DDSDA)	;Determine DDSDA
  115: 	;
  116: 	N I
  117: 	I DA="" S DDSDA="" Q
  118: 	S DDSDA=DA_"," F I=1:1:DL S DDSDA=DDSDA_DA(I)_","
  119: 	Q