- 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 ---[H[J[2J[HDIAXM3 2302 printed Feb 19, 2025@00:11:22 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
