DICATTD2 ;SFISC/GFT-NUMERIC FIELD ;1/7/2009
;;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.
;
POST2 ;check NUMERIC
N L,D,DD,Z,T
S DD=$$G(34),D=$$G(33),Y=$$G(31) Q:Y="" S L=$$G(32) Q:L=""
I L<Y S DDSERROR=1,DDSBR="31^DICATT2^2.2" D HLP^DDSUTL("'MINIMUM' & 'MAXIMUM' ARE IN WRONG ORDER") Q
S DICATTMN="Type a "_$P("number^dollar amount",U,$$G(33)=1+1)_" between "_Y_" and "_L_", "_DD_" decimal digit"_$E("s",DD'=1)_"."
S DICATT5N="K:+X'=X",T=DD+1,Z="!(X?.E"_"1""."""_T_".N)"
DOLLAR I D,DICATTF-.001 S DICATT5N="S:X[""$"" X=$P(X,""$"",2) K:X'?"_$P(".""-""",U,Y<0)_".N.1""."".2N"
S DICATT5N=DICATT5N_"!(X>"_L_")!(X<"_Y_")"_Z_" X",DICATTLN=$L(L\1)+T-(T=1)+(L<0),DICATT2N="NJ"_DICATTLN_","_DD,DICATT3N=""
CHNG I DICATT5N=DICATT5 K DICATTMN ;No DICATTMN means no change
D:$D(DICATTMN) PUT^DDSVALF(98,"DICATT",1,DICATTMN)
Q
;
G(I) N X Q $$GET^DDSVALF(I,"DICATT2",2.2,"I","")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTD2 1151 printed Nov 22, 2024@17:55:35 Page 2
DICATTD2 ;SFISC/GFT-NUMERIC FIELD ;1/7/2009
+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 ;
POST2 ;check NUMERIC
+1 NEW L,D,DD,Z,T
+2 SET DD=$$G(34)
SET D=$$G(33)
SET Y=$$G(31)
if Y=""
QUIT
SET L=$$G(32)
if L=""
QUIT
+3 IF L<Y
SET DDSERROR=1
SET DDSBR="31^DICATT2^2.2"
DO HLP^DDSUTL("'MINIMUM' & 'MAXIMUM' ARE IN WRONG ORDER")
QUIT
+4 SET DICATTMN="Type a "_$PIECE("number^dollar amount",U,$$G(33)=1+1)_" between "_Y_" and "_L_", "_DD_" decimal digit"_$EXTRACT("s",DD'=1)_"."
+5 SET DICATT5N="K:+X'=X"
SET T=DD+1
SET Z="!(X?.E"_"1""."""_T_".N)"
DOLLAR IF D
IF DICATTF-.001
SET DICATT5N="S:X[""$"" X=$P(X,""$"",2) K:X'?"_$PIECE(".""-""",U,Y<0)_".N.1""."".2N"
+1 SET DICATT5N=DICATT5N_"!(X>"_L_")!(X<"_Y_")"_Z_" X"
SET DICATTLN=$LENGTH(L\1)+T-(T=1)+(L<0)
SET DICATT2N="NJ"_DICATTLN_","_DD
SET DICATT3N=""
CHNG ;No DICATTMN means no change
IF DICATT5N=DICATT5
KILL DICATTMN
+1 if $DATA(DICATTMN)
DO PUT^DDSVALF(98,"DICATT",1,DICATTMN)
+2 QUIT
+3 ;
G(I) NEW X
QUIT $$GET^DDSVALF(I,"DICATT2",2.2,"I","")
