File:  [Coherent Logic Development] / freem_fileman / USER / DIAXM2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIAXM2	;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/11/93  2:59 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: P	K DIC
    5: 	;
    6: P1	S DIC="^DD("_+$P($P(Y(0),U,2),"P",2)_",",DIC(0)="Z",X=.01
    7: 	D ^DIC I Y'>0 S DIAXEM=DIAXFR("NM")_" points to missing pointed to file." D E Q
    8: 	S DIAXFTY=$$TYP^DIAXMS($P(Y(0),U,2)) Q:$D(DIAXMSG)
    9: 	I $P(Y(0),U,2)["P" G P1
   10: 	Q:$D(DIAXVPTR)
   11: 	D EN1^DIAXM
   12: 	Q
   13: V	S DIAXVPTR=1,DIAXZZ=0,DIAXVFLD=+Y,DIAXVFI=DK
   14: 	;
   15: V1	F  S DIAXZZ=$O(^DD(DK,DIAXVFLD,"V","B",DIAXZZ)) Q:DIAXZZ'>0  D V2 Q:$D(DIAXMSG)
   16: 	Q:$D(DIAXMSG)
   17: 	S DIAXFR("TY")=$S(DIAXFR("TY")["F":DIAXFR("TY"),1:"F"),DIAXFR("TYP")="F"
   18: 	S DIAXFR("LO")=$S(+DIAXFR("LO")+1:DIAXFR("LO"),1:3)
   19: 	S DIAXFR("HI")=$S(+DIAXFR("HI")+1:DIAXFR("HI"),1:45)
   20: 	S DIAXFT=DIAXFR("TY"),Y(0)=U_DIAXFT K DIAXVPTR D EN^DIAXM1
   21: 	Q
   22: V2	S DIC="^DD(+DIAXZZ,",DIC(0)="Z",X=.01 D ^DIC I Y'>0 S DIAXEM="Missing pointed to file." D E Q
   23: 	I $P(Y(0),U,2)["P" D P1 Q:$D(DIAXMSG)
   24: 	D IN^DIAXM Q:$D(DIAXMSG)
   25: 	S DIAXFR("TY")=$S($G(DIAXFR("TY"))["F":DIAXFR("TY"),1:DIAXVFR("TY"))
   26: 	S:DIAXVFR("TY")["F" DIAXFR("LO")=$S(+$G(DIAXFR("LO"))<DIAXVFR("LO"):+$G(DIAXFR("LO")),1:DIAXVFR("LO"))
   27: 	S:DIAXVFR("TY")["F" DIAXFR("HI")=$S(+$G(DIAXFR("HI"))>DIAXVFR("HI"):+$G(DIAXFR("HI")),1:DIAXVFR("HI"))
   28: 	Q
   29: 	;
   30: S	S DIAXZ=$P(Y(0),U,3),DIAXZL=0,DIAXPC=$S(DIAXEXT:2,1:1)
   31: 	F DIAXZZ=1:1:$L(DIAXZ,";") S DIAXZY=$P(DIAXZ,";",DIAXZZ) Q:DIAXZY=""  S DIAXZL=$S($L($P(DIAXZY,":",DIAXPC))>+DIAXZL:$L($P(DIAXZY,":",DIAXPC)),1:+DIAXZL),DIAXZLL=$S(+$G(DIAXZLL)<DIAXZL:+$G(DIAXZLL),1:DIAXZL)
   32: 	D HL^DIAXM(DIAXZL,DIAXZLL)
   33: 	Q
   34: 	;
   35: C	S DIAXFR("DC")=+$P($P(Y(0),U,2),",",2)
   36: 	S DIAXFR("LE")=+$P($P(Y(0),U,2),"J",2)
   37: 	Q
   38: 	;
   39: CN	I DIAXFR("TY")["B",DIAXTO("LO")'=0 D E1 S DIAXEM=DIAXEM_"have a minimum value of 0." D E Q
   40: 	I DIAXFR("TY")["J",DIAXTO("DC")<DIAXFR("DC") D E1 S DIAXEM=DIAXEM_"have at least "_DIAXFR("DC")_" decimal places." D E
   41: 	I DIAXFR("TY")["J",DIAXFR("LE")>DIAXTO("LE") D E1 S DIAXEM=DIAXEM_"be at least "_DIAXFR("LE")_" characters long." D E
   42: 	Q
   43: 	;
   44: CF	I DIAXFR("TY")["B",DIAXTO("LO")'=1 D E1 S DIAXEM=DIAXEM_"have a minimum length of 1." D E Q
   45: 	Q:DIAXFR("TY")["B"
   46: 	I DIAXFR("TY")["D",DIAXTO("LO")>7 D E1 S DIAXEM=DIAXEM_"a minimum length of at least 7." D E
   47: 	I DIAXFR("TY")["D",DIAXTO("HI")<7 D E1 S DIAXEM=DIAXEM_"a maximum length of at least 7." D E
   48: 	I DIAXFR("TY")["J",DIAXFR("LE")<DIAXTO("LO") D E1 S DIAXEM=DIAXEM_"have a minimum length of at least"_DIAXFR("LE")_" characters." D E
   49: 	I DIAXFR("TY")["J",DIAXFR("LE")>DIAXTO("HI") D E1 S DIAXEM=DIAXEM_"have a maximum length of at least "_DIAXFR("LE")_" characters." D E
   50: 	Q
   51: 	;
   52: CD	I DIAXFR("TY")["D",+DIAXTO("LO")!+DIAXTO("HI") D E1 S DIAXEM=DIAXEM_"not have set date ranges." D E
   53: 	Q
   54: 	;
   55: E1	S DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$S($D(DIAXSB):" subfile",1:" file")_" should " Q
   56: 	;
   57: E	D ERR^DIAXERR(DIAXEM)
   58: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>