File:  [Coherent Logic Development] / freem_fileman / USER / DIAXM3.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: DIAXM3	;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/3/93  12:23 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: N	S DIAXNO=$P(Y(0),U,2),DIAXLE=+$P(DIAXNO,"J",2) S:DIAXFR DIAXFR("DLR")=$P(Y(0),U,5)["$"
    5: 	S @(DIAXA_"(""LE"")")=DIAXLE,@(DIAXA_"(""DC"")")=+$P(DIAXNO,",",2)
    6: 	Q:DIAXFR  I DIAXFR("TY")["C" D CN^DIAXM2 Q
    7: 	I DIAXFR("TY")["P" G N1
    8: 	I DIAXFR("DLR"),DIAXTO("DC")<2 D E3 S DIAXEM=DIAXEM_"contain at least 2 decimal places." D E
    9: 	I DIAXFR("DC")>DIAXTO("DC") D E3 S DIAXEM=DIAXEM_"contain at least "_DIAXFR("DC")_" decimal places." D E
   10: 	I DIAXFR("LE")>DIAXTO("LE") D E3 S DIAXEM=DIAXEM_"be at least "_DIAXFR("LE")_" digits long." D E
   11: N1	I DIAXTO("LO")>DIAXFR("LO") S DIAXE2=DIAXFR("LO") D E1,E3,E4
   12: 	I DIAXTO("HI")<DIAXFR("HI") S DIAXE2=DIAXFR("HI") D E2,E4
   13: 	Q
   14: 	;
   15: D	S DIAXDT=$P(Y(0),U,5,99),DIAXLO=$P($P(DIAXDT,"<X!(",2),">X"),DIAXHI=$P($P(DIAXDT,"K:",2),"<X!(")
   16: 	S @(DIAXA_"(""DT"")")=$P(DIAXDT,"""",2) D HL^DIAXM(+DIAXHI,+DIAXLO)
   17: 	Q:DIAXFR  I DIAXFR("TY")["C" D CD^DIAXM2 Q
   18: 	I DIAXTO("DT")["R",DIAXFR("DT")'["R" D E3 S DIAXEM=DIAXEM_"not 'R'equire time." D E
   19: 	I DIAXTO("DT")["S",DIAXFR("DT")'["S" D E3 S DIAXEM=DIAXEM_"not expect 'S'econds to be returned." D E
   20: 	I DIAXTO("DT")["X",DIAXFR("DT")'["X" D E3 S DIAXEM=DIAXEM_"not require e'X'act date." D E
   21: 	I DIAXTO("LO"),'DIAXFR("LO") D E3 S DIAXEM=DIAXEM_"not have an earliest date." D E
   22: 	I DIAXTO("HI"),'DIAXFR("HI") D E3 S DIAXEM=DIAXEM_"not have a latest date." D E
   23: 	I DIAXTO("LO"),DIAXTO("LO")>DIAXFR("LO") S DIAXDTY=DIAXFR("LO") D DT,E3 S DIAXEM=DIAXEM_"have an earliest date of at least "_DIAXDTY D E
   24: 	I DIAXTO("HI"),DIAXTO("HI")<DIAXFR("HI") S DIAXDTY=DIAXFR("HI") D DT,E3 S DIAXEM=DIAXEM_"have a latest date of at least "_DIAXDTY D E
   25: 	Q
   26: 	;
   27: DT	N Y
   28: 	S Y=DIAXDTY X ^DD("DD") S DIAXDTY=Y
   29: 	Q
   30: 	;
   31: E1	S DIAXE1="minimum" Q
   32: E2	S DIAXE1="maximum"
   33: E3	S DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$S($D(DIAXSB):" subfile",1:" file")_" should " Q
   34: E4	S DIAXEM=DIAXEM_"have a "_DIAXE1_" value of at least "_DIAXE2
   35: E	D ERR^DIAXERR(DIAXEM)
   36: 	K DIAXE1,DIAXE2
   37: 	Q

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