Return to DIAXM1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXM1.m, revision 1.1

1.1     ! snw         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