- DIAXM2 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/11/93 2:59 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.
- ;
- P K DIC
- ;
- P1 S DIC="^DD("_+$P($P(Y(0),U,2),"P",2)_",",DIC(0)="Z",X=.01
- D ^DIC I Y'>0 S DIAXEM=DIAXFR("NM")_" points to missing pointed to file." D E Q
- S DIAXFTY=$$TYP^DIAXMS($P(Y(0),U,2)) Q:$D(DIAXMSG)
- I $P(Y(0),U,2)["P" G P1
- Q:$D(DIAXVPTR)
- D EN1^DIAXM
- Q
- V S DIAXVPTR=1,DIAXZZ=0,DIAXVFLD=+Y,DIAXVFI=DK
- ;
- V1 F S DIAXZZ=$O(^DD(DK,DIAXVFLD,"V","B",DIAXZZ)) Q:DIAXZZ'>0 D V2 Q:$D(DIAXMSG)
- Q:$D(DIAXMSG)
- S DIAXFR("TY")=$S(DIAXFR("TY")["F":DIAXFR("TY"),1:"F"),DIAXFR("TYP")="F"
- S DIAXFR("LO")=$S(+DIAXFR("LO")+1:DIAXFR("LO"),1:3)
- S DIAXFR("HI")=$S(+DIAXFR("HI")+1:DIAXFR("HI"),1:45)
- S DIAXFT=DIAXFR("TY"),Y(0)=U_DIAXFT K DIAXVPTR D EN^DIAXM1
- Q
- V2 S DIC="^DD(+DIAXZZ,",DIC(0)="Z",X=.01 D ^DIC I Y'>0 S DIAXEM="Missing pointed to file." D E Q
- I $P(Y(0),U,2)["P" D P1 Q:$D(DIAXMSG)
- D IN^DIAXM Q:$D(DIAXMSG)
- S DIAXFR("TY")=$S($G(DIAXFR("TY"))["F":DIAXFR("TY"),1:DIAXVFR("TY"))
- S:DIAXVFR("TY")["F" DIAXFR("LO")=$S(+$G(DIAXFR("LO"))<DIAXVFR("LO"):+$G(DIAXFR("LO")),1:DIAXVFR("LO"))
- S:DIAXVFR("TY")["F" DIAXFR("HI")=$S(+$G(DIAXFR("HI"))>DIAXVFR("HI"):+$G(DIAXFR("HI")),1:DIAXVFR("HI"))
- Q
- ;
- S S DIAXZ=$P(Y(0),U,3),DIAXZL=0,DIAXPC=$S(DIAXEXT:2,1:1)
- F DIAXZZ=1:1:$L(DIAXZ,";") S DIAXZY=$P(DIAXZ,";",DIAXZZ) Q:DIAXZY="" S DIAXZL=$S($L($P(DIAXZY,":",DIAXPC))>+DIAXZL:$L($P(DIAXZY,":",DIAXPC)),1:+DIAXZL),DIAXZLL=$S(+$G(DIAXZLL)<DIAXZL:+$G(DIAXZLL),1:DIAXZL)
- D HL^DIAXM(DIAXZL,DIAXZLL)
- Q
- ;
- C S DIAXFR("DC")=+$P($P(Y(0),U,2),",",2)
- S DIAXFR("LE")=+$P($P(Y(0),U,2),"J",2)
- Q
- ;
- CN I DIAXFR("TY")["B",DIAXTO("LO")'=0 D E1 S DIAXEM=DIAXEM_"have a minimum value of 0." D E Q
- I DIAXFR("TY")["J",DIAXTO("DC")<DIAXFR("DC") D E1 S DIAXEM=DIAXEM_"have at least "_DIAXFR("DC")_" decimal places." D E
- I DIAXFR("TY")["J",DIAXFR("LE")>DIAXTO("LE") D E1 S DIAXEM=DIAXEM_"be at least "_DIAXFR("LE")_" characters long." D E
- Q
- ;
- CF I DIAXFR("TY")["B",DIAXTO("LO")'=1 D E1 S DIAXEM=DIAXEM_"have a minimum length of 1." D E Q
- Q:DIAXFR("TY")["B"
- I DIAXFR("TY")["D",DIAXTO("LO")>7 D E1 S DIAXEM=DIAXEM_"a minimum length of at least 7." D E
- I DIAXFR("TY")["D",DIAXTO("HI")<7 D E1 S DIAXEM=DIAXEM_"a maximum length of at least 7." D E
- I DIAXFR("TY")["J",DIAXFR("LE")<DIAXTO("LO") D E1 S DIAXEM=DIAXEM_"have a minimum length of at least"_DIAXFR("LE")_" characters." D E
- I DIAXFR("TY")["J",DIAXFR("LE")>DIAXTO("HI") D E1 S DIAXEM=DIAXEM_"have a maximum length of at least "_DIAXFR("LE")_" characters." D E
- Q
- ;
- CD I DIAXFR("TY")["D",+DIAXTO("LO")!+DIAXTO("HI") D E1 S DIAXEM=DIAXEM_"not have set date ranges." D E
- Q
- ;
- E1 S DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$S($D(DIAXSB):" subfile",1:" file")_" should " Q
- ;
- E D ERR^DIAXERR(DIAXEM)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIAXM2 3075 printed Feb 19, 2025@00:11:21 Page 2
- DIAXM2 ;SFISC/DCM-PROCESS MAPPING INFORMATION (CONT) ;3/11/93 2:59 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 ;
- P KILL DIC
- +1 ;
- P1 SET DIC="^DD("_+$PIECE($PIECE(Y(0),U,2),"P",2)_","
- SET DIC(0)="Z"
- SET X=.01
- +1 DO ^DIC
- IF Y'>0
- SET DIAXEM=DIAXFR("NM")_" points to missing pointed to file."
- DO E
- QUIT
- +2 SET DIAXFTY=$$TYP^DIAXMS($PIECE(Y(0),U,2))
- if $DATA(DIAXMSG)
- QUIT
- +3 IF $PIECE(Y(0),U,2)["P"
- GOTO P1
- +4 if $DATA(DIAXVPTR)
- QUIT
- +5 DO EN1^DIAXM
- +6 QUIT
- V SET DIAXVPTR=1
- SET DIAXZZ=0
- SET DIAXVFLD=+Y
- SET DIAXVFI=DK
- +1 ;
- V1 FOR
- SET DIAXZZ=$ORDER(^DD(DK,DIAXVFLD,"V","B",DIAXZZ))
- if DIAXZZ'>0
- QUIT
- DO V2
- if $DATA(DIAXMSG)
- QUIT
- +1 if $DATA(DIAXMSG)
- QUIT
- +2 SET DIAXFR("TY")=$SELECT(DIAXFR("TY")["F":DIAXFR("TY"),1:"F")
- SET DIAXFR("TYP")="F"
- +3 SET DIAXFR("LO")=$SELECT(+DIAXFR("LO")+1:DIAXFR("LO"),1:3)
- +4 SET DIAXFR("HI")=$SELECT(+DIAXFR("HI")+1:DIAXFR("HI"),1:45)
- +5 SET DIAXFT=DIAXFR("TY")
- SET Y(0)=U_DIAXFT
- KILL DIAXVPTR
- DO EN^DIAXM1
- +6 QUIT
- V2 SET DIC="^DD(+DIAXZZ,"
- SET DIC(0)="Z"
- SET X=.01
- DO ^DIC
- IF Y'>0
- SET DIAXEM="Missing pointed to file."
- DO E
- QUIT
- +1 IF $PIECE(Y(0),U,2)["P"
- DO P1
- if $DATA(DIAXMSG)
- QUIT
- +2 DO IN^DIAXM
- if $DATA(DIAXMSG)
- QUIT
- +3 SET DIAXFR("TY")=$SELECT($GET(DIAXFR("TY"))["F":DIAXFR("TY"),1:DIAXVFR("TY"))
- +4 if DIAXVFR("TY")["F"
- SET DIAXFR("LO")=$SELECT(+$GET(DIAXFR("LO"))<DIAXVFR("LO"):+$GET(DIAXFR("LO")),1:DIAXVFR("LO"))
- +5 if DIAXVFR("TY")["F"
- SET DIAXFR("HI")=$SELECT(+$GET(DIAXFR("HI"))>DIAXVFR("HI"):+$GET(DIAXFR("HI")),1:DIAXVFR("HI"))
- +6 QUIT
- +7 ;
- S SET DIAXZ=$PIECE(Y(0),U,3)
- SET DIAXZL=0
- SET DIAXPC=$SELECT(DIAXEXT:2,1:1)
- +1 FOR DIAXZZ=1:1:$LENGTH(DIAXZ,";")
- SET DIAXZY=$PIECE(DIAXZ,";",DIAXZZ)
- if DIAXZY=""
- QUIT
- SET DIAXZL=$SELECT($LENGTH($PIECE(DIAXZY,":",DIAXPC))>+DIAXZL:$LENGTH($PIECE(DIAXZY,":",DIAXPC)),1:+DIAXZL)
- SET DIAXZLL=$SELECT(+$GET(DIAXZLL)<DIAXZL:+$GET(DIAXZLL),1:DIAXZL)
- +2 DO HL^DIAXM(DIAXZL,DIAXZLL)
- +3 QUIT
- +4 ;
- C SET DIAXFR("DC")=+$PIECE($PIECE(Y(0),U,2),",",2)
- +1 SET DIAXFR("LE")=+$PIECE($PIECE(Y(0),U,2),"J",2)
- +2 QUIT
- +3 ;
- CN IF DIAXFR("TY")["B"
- IF DIAXTO("LO")'=0
- DO E1
- SET DIAXEM=DIAXEM_"have a minimum value of 0."
- DO E
- QUIT
- +1 IF DIAXFR("TY")["J"
- IF DIAXTO("DC")<DIAXFR("DC")
- DO E1
- SET DIAXEM=DIAXEM_"have at least "_DIAXFR("DC")_" decimal places."
- DO E
- +2 IF DIAXFR("TY")["J"
- IF DIAXFR("LE")>DIAXTO("LE")
- DO E1
- SET DIAXEM=DIAXEM_"be at least "_DIAXFR("LE")_" characters long."
- DO E
- +3 QUIT
- +4 ;
- CF IF DIAXFR("TY")["B"
- IF DIAXTO("LO")'=1
- DO E1
- SET DIAXEM=DIAXEM_"have a minimum length of 1."
- DO E
- QUIT
- +1 if DIAXFR("TY")["B"
- QUIT
- +2 IF DIAXFR("TY")["D"
- IF DIAXTO("LO")>7
- DO E1
- SET DIAXEM=DIAXEM_"a minimum length of at least 7."
- DO E
- +3 IF DIAXFR("TY")["D"
- IF DIAXTO("HI")<7
- DO E1
- SET DIAXEM=DIAXEM_"a maximum length of at least 7."
- DO E
- +4 IF DIAXFR("TY")["J"
- IF DIAXFR("LE")<DIAXTO("LO")
- DO E1
- SET DIAXEM=DIAXEM_"have a minimum length of at least"_DIAXFR("LE")_" characters."
- DO E
- +5 IF DIAXFR("TY")["J"
- IF DIAXFR("LE")>DIAXTO("HI")
- DO E1
- SET DIAXEM=DIAXEM_"have a maximum length of at least "_DIAXFR("LE")_" characters."
- DO E
- +6 QUIT
- +7 ;
- CD IF DIAXFR("TY")["D"
- IF +DIAXTO("LO")!+DIAXTO("HI")
- DO E1
- SET DIAXEM=DIAXEM_"not have set date ranges."
- DO E
- +1 QUIT
- +2 ;
- E1 SET DIAXEM=DIAXTO("NM")_" field in "_DIAXEF_$SELECT($DATA(DIAXSB):" subfile",1:" file")_" should "
- QUIT
- +1 ;
- E DO ERR^DIAXERR(DIAXEM)
- +1 QUIT
