Return to DIAXM1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIAXM1	;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/5/93  9:41 AM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN	D @DIAXFTY Q:DIAXFR
    5: 	I DIAXFR("TYP")'=DIAXTO("TYP"),'$D(DIAXEXT) S DIAXEXT=1
    6: 	D:'$D(DIAR) DJ
    7: 	Q
    8: 	;
    9: F	Q:DIAXFR  I DIAXFR("TY")["C" D CF^DIAXM2 Q
   10: 	I "FSP"[DIAXFR("TYP"),+DIAXFR("LO"),DIAXFR("LO")<DIAXTO("LO") S DIAXE2=DIAXFR("LO") D E1,E3
   11: 	I "FSP"[DIAXFR("TYP"),DIAXFR("HI")>DIAXTO("HI") S DIAXE2=DIAXFR("HI") D E2
   12: 	I DIAXFR("TY")["N",DIAXFR("LE")<DIAXTO("LO") S DIAXE2=DIAXFR("LE") D E1,E3
   13: 	I DIAXFR("TY")["N",DIAXFR("LE")>DIAXTO("HI") S DIAXE2=DIAXFR("LE") D E2
   14: 	I DIAXFR("TY")["D",DIAXTO("LO")>14 S DIAXE2=14 D E1,E3
   15: 	I DIAXFR("TY")["D",DIAXTO("HI")<14 S DIAXE2=14 D E2
   16: 	Q
   17: 	;
   18: N	G N^DIAXM3
   19: 	;
   20: D	G D^DIAXM3
   21: 	;
   22: P	D XT I DIAXEXT D P^DIAXM2 Q:$D(DIAXMSG)!DIAXFR
   23: 	D HL^DIAXM(15,1)
   24: 	Q
   25: 	;
   26: V	D XT I DIAXEXT D V^DIAXM2 Q:$D(DIAXMSG)!DIAXFR
   27: 	D HL^DIAXM(30,3)
   28: 	Q
   29: 	;
   30: C	G C^DIAXM2
   31: 	;
   32: S	I DIAXTO W:'$D(DIAR) !?DIAXTAB,$C(7),"Make sure the SET OF CODES are identical as the extract field." Q
   33: 	D XT D S^DIAXM2
   34: 	Q
   35: 	;
   36: W	Q:DIAXFR
   37: 	I DIAXFR("TY")["L",DIAXTO("TY")'["L" D E3 S DIAXEM=DIAXEM_"be in 'L'ine mode." D X
   38: 	Q
   39: 	;
   40: K	Q
   41: 	;
   42: E1	S DIAXE1="minimum" Q
   43: E2	S DIAXE1="maximum"
   44: E3	S DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$S($D(DIAXSB):" subfile",1:" file")_" should " Q:DIAXFTY["W"
   45: 	S DIAXEM=DIAXEM_"have a "_DIAXE1_" length of at least "_DIAXE2_" characters."
   46: X	D ERR^DIAXERR(DIAXEM)
   47: 	K DIAXE1,DIAXE2
   48: 	Q
   49: 	;
   50: DJ	S DIAXDJ=DIAXDJ+1
   51: 	S ^UTILITY("DIFG",$J,DIAXC,DIAXDJ)=DIAXS_U_U_+Y_U_$P(Y(0),U,4)_U_$G(DIAXEXT)
   52: 	S S=DIAXS,DJ=DIAXDJ,C=DIAXC
   53: 	Q
   54: 	;
   55: XT	S DIAXEXT=+$G(DIAXEXT) I '$D(DIAR),$D(DC(DC)) S DIAXEXT=+$P(DC(DC),U,5) Q:'DINS
   56: 	Q:$D(DIAR)
   57: 	K DIR N Y S DIR(0)="Y",DIR("A")="Move EXTERNAL form of the data to the extract field",DIR("B")="Yes",DIR("?")="Answer YES if the RESOLVED value of data should be moved"
   58: 	D ^DIR K DIR Q:'Y
   59: 	S DIAXEXT=1
   60: 	Q