Return to DIAXM1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIAXM1.m, revision 1.1.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