DIAXM3.m

DIAXM3 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/3/93  12:23 PM

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

N S DIAXNO=$P(Y(0),U,2),DIAXLE=+$P(DIAXNO,"J",2) S:DIAXFR DIAXFR("DLR")=$P(Y(0),U,5)["$"

 S @(DIAXA_"(""LE"")")=DIAXLE,@(DIAXA_"(""DC"")")=+$P(DIAXNO,",",2)

 Q:DIAXFR  I DIAXFR("TY")["C" D CN^DIAXM2 Q

 I DIAXFR("TY")["P" G N1

 I DIAXFR("DLR"),DIAXTO("DC")<2 D E3 S DIAXEM=DIAXEM_"contain at least 2 decimal places." D E

 I DIAXFR("DC")>DIAXTO("DC") D E3 S DIAXEM=DIAXEM_"contain at least "_DIAXFR("DC")_" decimal places." D E

 I DIAXFR("LE")>DIAXTO("LE") D E3 S DIAXEM=DIAXEM_"be at least "_DIAXFR("LE")_" digits long." D E

N1 I DIAXTO("LO")>DIAXFR("LO") S DIAXE2=DIAXFR("LO") D E1,E3,E4

 I DIAXTO("HI")<DIAXFR("HI") S DIAXE2=DIAXFR("HI") D E2,E4

 Q

 ;

D S DIAXDT=$P(Y(0),U,5,99),DIAXLO=$P($P(DIAXDT,"<X!(",2),">X"),DIAXHI=$P($P(DIAXDT,"K:",2),"<X!(")

 S @(DIAXA_"(""DT"")")=$P(DIAXDT,"""",2) D HL^DIAXM(+DIAXHI,+DIAXLO)

 Q:DIAXFR  I DIAXFR("TY")["C" D CD^DIAXM2 Q

 I DIAXTO("DT")["R",DIAXFR("DT")'["R" D E3 S DIAXEM=DIAXEM_"not 'R'equire time." D E

 I DIAXTO("DT")["S",DIAXFR("DT")'["S" D E3 S DIAXEM=DIAXEM_"not expect 'S'econds to be returned." D E

 I DIAXTO("DT")["X",DIAXFR("DT")'["X" D E3 S DIAXEM=DIAXEM_"not require e'X'act date." D E

 I DIAXTO("LO"),'DIAXFR("LO") D E3 S DIAXEM=DIAXEM_"not have an earliest date." D E

 I DIAXTO("HI"),'DIAXFR("HI") D E3 S DIAXEM=DIAXEM_"not have a latest date." D E

 I DIAXTO("LO"),DIAXTO("LO")>DIAXFR("LO") S DIAXDTY=DIAXFR("LO") D DT,E3 S DIAXEM=DIAXEM_"have an earliest date of at least "_DIAXDTY D E

 I DIAXTO("HI"),DIAXTO("HI")<DIAXFR("HI") S DIAXDTY=DIAXFR("HI") D DT,E3 S DIAXEM=DIAXEM_"have a latest date of at least "_DIAXDTY D E

 Q

 ;

DT N Y

 S Y=DIAXDTY X ^DD("DD") S DIAXDTY=Y

 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

E4 S DIAXEM=DIAXEM_"have a "_DIAXE1_" value of at least "_DIAXE2

E D ERR^DIAXERR(DIAXEM)

 K DIAXE1,DIAXE2

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIAXM3   2302     printed  Apr 09, 2024@21:53:05                                                                                                                                                                                                      Page 2

DIAXM3    ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/3/93  12:23 PM

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

N          SET DIAXNO=$PIECE(Y(0),U,2)

           SET DIAXLE=+$PIECE(DIAXNO,"J",2)

           if DIAXFR

               SET DIAXFR("DLR")=$PIECE(Y(0),U,5)["$"

 +1        SET @(DIAXA_"(""LE"")")=DIAXLE

           SET @(DIAXA_"(""DC"")")=+$PIECE(DIAXNO,",",2)

 +2        if DIAXFR

               QUIT 

           IF DIAXFR("TY")["C"

               DO CN^DIAXM2

               QUIT 

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

               GOTO N1

 +4        IF DIAXFR("DLR")

               IF DIAXTO("DC")<2

                   DO E3

                   SET DIAXEM=DIAXEM_"contain at least 2 decimal places."

                   DO E

 +5        IF DIAXFR("DC")>DIAXTO("DC")

               DO E3

               SET DIAXEM=DIAXEM_"contain at least "_DIAXFR("DC")_" decimal places."

               DO E

 +6        IF DIAXFR("LE")>DIAXTO("LE")

               DO E3

               SET DIAXEM=DIAXEM_"be at least "_DIAXFR("LE")_" digits long."

               DO E

N1         IF DIAXTO("LO")>DIAXFR("LO")

               SET DIAXE2=DIAXFR("LO")

               DO E1

               DO E3

               DO E4

 +1        IF DIAXTO("HI")<DIAXFR("HI")

               SET DIAXE2=DIAXFR("HI")

               DO E2

               DO E4

 +2        QUIT 

 +3       ;

D          SET DIAXDT=$PIECE(Y(0),U,5,99)

           SET DIAXLO=$PIECE($PIECE(DIAXDT,"<X!(",2),">X")

           SET DIAXHI=$PIECE($PIECE(DIAXDT,"K:",2),"<X!(")

 +1        SET @(DIAXA_"(""DT"")")=$PIECE(DIAXDT,"""",2)

           DO HL^DIAXM(+DIAXHI,+DIAXLO)

 +2        if DIAXFR

               QUIT 

           IF DIAXFR("TY")["C"

               DO CD^DIAXM2

               QUIT 

 +3        IF DIAXTO("DT")["R"

               IF DIAXFR("DT")'["R"

                   DO E3

                   SET DIAXEM=DIAXEM_"not 'R'equire time."

                   DO E

 +4        IF DIAXTO("DT")["S"

               IF DIAXFR("DT")'["S"

                   DO E3

                   SET DIAXEM=DIAXEM_"not expect 'S'econds to be returned."

                   DO E

 +5        IF DIAXTO("DT")["X"

               IF DIAXFR("DT")'["X"

                   DO E3

                   SET DIAXEM=DIAXEM_"not require e'X'act date."

                   DO E

 +6        IF DIAXTO("LO")

               IF 'DIAXFR("LO")

                   DO E3

                   SET DIAXEM=DIAXEM_"not have an earliest date."

                   DO E

 +7        IF DIAXTO("HI")

               IF 'DIAXFR("HI")

                   DO E3

                   SET DIAXEM=DIAXEM_"not have a latest date."

                   DO E

 +8        IF DIAXTO("LO")

               IF DIAXTO("LO")>DIAXFR("LO")

                   SET DIAXDTY=DIAXFR("LO")

                   DO DT

                   DO E3

                   SET DIAXEM=DIAXEM_"have an earliest date of at least "_DIAXDTY

                   DO E

 +9        IF DIAXTO("HI")

               IF DIAXTO("HI")<DIAXFR("HI")

                   SET DIAXDTY=DIAXFR("HI")

                   DO DT

                   DO E3

                   SET DIAXEM=DIAXEM_"have a latest date of at least "_DIAXDTY

                   DO E

 +10       QUIT 

 +11      ;

DT         NEW Y

 +1        SET Y=DIAXDTY

           XECUTE ^DD("DD")

           SET DIAXDTY=Y

 +2        QUIT 

 +3       ;

E1         SET DIAXE1="minimum"

           QUIT 

E2         SET DIAXE1="maximum"

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

           QUIT 

E4         SET DIAXEM=DIAXEM_"have a "_DIAXE1_" value of at least "_DIAXE2

E          DO ERR^DIAXERR(DIAXEM)

 +1        KILL DIAXE1,DIAXE2

 +2        QUIT