DIAXM1.m

DIAXM1 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;7/11/95  06:33

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

EN D @DIAXFTY Q:DIAXFR  Q:$D(DIAXMSG)

 I DIAXFR("TYP")'=DIAXTO("TYP"),'$D(DIAXEXT) S DIAXEXT=1

 D:'$D(DIAR) DJ

 Q

 ;

F Q:DIAXFR!($D(DIAXMSG))  I DIAXFR("TY")["C" D CF^DIAXM2 Q

 I "FSP"[DIAXFR("TYP"),+DIAXFR("LO"),DIAXFR("LO")<DIAXTO("LO") S DIAXE2=DIAXFR("LO") D E1,E3

 I "FSP"[DIAXFR("TYP"),DIAXFR("HI")>DIAXTO("HI") S DIAXE2=DIAXFR("HI") D E2

 I DIAXFR("TY")["N",DIAXFR("LE")<DIAXTO("LO") S DIAXE2=DIAXFR("LE") D E1,E3

 I DIAXFR("TY")["N",DIAXFR("LE")>DIAXTO("HI") S DIAXE2=DIAXFR("LE") D E2

 I DIAXFR("TY")["D",DIAXTO("LO")>14 S DIAXE2=14 D E1,E3

 I DIAXFR("TY")["D",DIAXTO("HI")<14 S DIAXE2=14 D E2

 Q

 ;

N G N^DIAXM3

 ;

D G D^DIAXM3

 ;

P D XT I DIAXEXT D P^DIAXM2 Q:$D(DIAXMSG)!DIAXFR

 D HL^DIAXM(15,1)

 Q

 ;

V D XT I DIAXEXT D V^DIAXM2 Q:$D(DIAXMSG)!DIAXFR

 D HL^DIAXM(30,3)

 Q

 ;

C G C^DIAXM2

 ;

S I DIAXTO W:'$D(DIAR) !?DIAXTAB,$C(7),"Make sure the SET OF CODES are identical as the extract field." Q

 D XT D S^DIAXM2

 Q

 ;

W Q:DIAXFR

 I DIAXFR("TY")["L",DIAXTO("TY")'["L" D E3 S DIAXEM=DIAXEM_"be in 'L'ine mode." D X

 Q

 ;

K Q

 ;

E1 S DIAXE1="minimum" Q

E2 S DIAXE1="maximum"

E3 S DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$S($D(DIAXSB):" subfile",1:" file")_" should " Q:DIAXFTY["W"

 S DIAXEM=DIAXEM_"have a "_DIAXE1_" length of at least "_DIAXE2_" characters."

X D ERR^DIAXERR(DIAXEM)

 K DIAXE1,DIAXE2

 Q

 ;

DJ S DIAXDJ=DIAXDJ+1

 S ^UTILITY("DIFG",$J,DIAXC,DIAXDJ)=DIAXS_U_U_+Y_U_$P(Y(0),U,4)_U_$G(DIAXEXT)

 S S=DIAXS,DJ=DIAXDJ,C=DIAXC

 Q

 ;

XT S DIAXEXT=+$G(DIAXEXT) I '$D(DIAR),$D(DC(DC)) S DIAXEXT=+$P(DC(DC),U,5) Q:'DINS

 Q:$D(DIAR)

 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"

 D ^DIR K DIR Q:'Y

 S DIAXEXT=1

 Q

DIAXM1    ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;7/11/95  06:33

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

EN         DO @DIAXFTY

           IF DIAXFR

               QUIT 

           IF $DATA(DIAXMSG)

               QUIT 

 +1        IF DIAXFR("TYP")'=DIAXTO("TYP")

               IF '$DATA(DIAXEXT)

                   SET DIAXEXT=1

 +2        IF '$DATA(DIAR)

               DO DJ

 +3        QUIT 

 +4       ;

F          IF DIAXFR!($DATA(DIAXMSG))

               QUIT 

           IF DIAXFR("TY")["C"

               DO CF^DIAXM2

               QUIT 

 +1        IF "FSP"[DIAXFR("TYP")

               IF +DIAXFR("LO")

                   IF DIAXFR("LO")<DIAXTO("LO")

                       SET DIAXE2=DIAXFR("LO")

                       DO E1

                       DO E3

 +2        IF "FSP"[DIAXFR("TYP")

               IF DIAXFR("HI")>DIAXTO("HI")

                   SET DIAXE2=DIAXFR("HI")

                   DO E2

 +3        IF DIAXFR("TY")["N"

               IF DIAXFR("LE")<DIAXTO("LO")

                   SET DIAXE2=DIAXFR("LE")

                   DO E1

                   DO E3

 +4        IF DIAXFR("TY")["N"

               IF DIAXFR("LE")>DIAXTO("HI")

                   SET DIAXE2=DIAXFR("LE")

                   DO E2

 +5        IF DIAXFR("TY")["D"

               IF DIAXTO("LO")>14

                   SET DIAXE2=14

                   DO E1

                   DO E3

 +6        IF DIAXFR("TY")["D"

               IF DIAXTO("HI")<14

                   SET DIAXE2=14

                   DO E2

 +7        QUIT 

 +8       ;

N          GOTO N^DIAXM3

 +1       ;

D          GOTO D^DIAXM3

 +1       ;

P          DO XT

           IF DIAXEXT

               DO P^DIAXM2

               IF $DATA(DIAXMSG)!DIAXFR

                   QUIT 

 +1        DO HL^DIAXM(15,1)

 +2        QUIT 

 +3       ;

V          DO XT

           IF DIAXEXT

               DO V^DIAXM2

               IF $DATA(DIAXMSG)!DIAXFR

                   QUIT 

 +1        DO HL^DIAXM(30,3)

 +2        QUIT 

 +3       ;

C          GOTO C^DIAXM2

 +1       ;

S          IF DIAXTO

               IF '$DATA(DIAR)

                   WRITE !?DIAXTAB,$CHAR(7),"Make sure the SET OF CODES are identical as the extract field."

               QUIT 

 +1        DO XT

           DO S^DIAXM2

 +2        QUIT 

 +3       ;

W          IF DIAXFR

               QUIT 

 +1        IF DIAXFR("TY")["L"

               IF DIAXTO("TY")'["L"

                   DO E3

                   SET DIAXEM=DIAXEM_"be in 'L'ine mode."

                   DO X

 +2        QUIT 

 +3       ;

K          QUIT 

 +1       ;

E1         SET DIAXE1="minimum"

           QUIT 

E2         SET DIAXE1="maximum"

E3         SET DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$SELECT($DATA(DIAXSB):" subfile",1:" file")_" should "

           IF DIAXFTY["W"

               QUIT 

 +1        SET DIAXEM=DIAXEM_"have a "_DIAXE1_" length of at least "_DIAXE2_" characters."

X          DO ERR^DIAXERR(DIAXEM)

 +1        KILL DIAXE1,DIAXE2

 +2        QUIT 

 +3       ;

DJ         SET DIAXDJ=DIAXDJ+1

 +1        SET ^UTILITY("DIFG",$JOB,DIAXC,DIAXDJ)=DIAXS_U_U_+Y_U_$PIECE(Y(0),U,4)_U_$GET(DIAXEXT)

 +2        SET S=DIAXS

           SET DJ=DIAXDJ

           SET C=DIAXC

 +3        QUIT 

 +4       ;

XT         SET DIAXEXT=+$GET(DIAXEXT)

           IF '$DATA(DIAR)

               IF $DATA(DC(DC))

                   SET DIAXEXT=+$PIECE(DC(DC),U,5)

                   IF 'DINS

                       QUIT 

 +1        IF $DATA(DIAR)

               QUIT 

 +2        KILL DIR

           NEW Y

           SET DIR(0)="Y"

           SET DIR("A")="Move EXTERNAL form of the data to the extract field"

           SET DIR("B")="Yes"

           SET DIR("?")="Answer YES if the RESOLVED value of data should be moved"

 +3        DO ^DIR

           KILL DIR

           IF 'Y

               QUIT 

 +4        SET DIAXEXT=1

 +5        QUIT