DICATTD2.m

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 ---DICATTD2   1151     printed  Apr 09, 2024@21:48:16                                                                                                                                                                                                    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","")