| [613] | 1 | DIAXM1 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;7/11/95 06:33
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN D @DIAXFTY Q:DIAXFR Q:$D(DIAXMSG)
|
|---|
| 5 | I DIAXFR("TYP")'=DIAXTO("TYP"),'$D(DIAXEXT) S DIAXEXT=1
|
|---|
| 6 | D:'$D(DIAR) DJ
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | F Q:DIAXFR!($D(DIAXMSG)) 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
|
|---|
