ASUJVALD ; IHS/ITSC/LMH -VALIDATE ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;This routine is called to validate fields
S ASUV("DDSREFT")=DDSREFT D:$G(ASUSB) CKFLD^ASUJBTCH
Q
EN(X,E,F,T) ;EP;Validate
;X-Entry to validate
;E-Error flag
;F-Field or line tage name
;T-Type (If Null, no test)
I X']"" D CL Q
K E
I T="F" D TBF ;Finance
I T="R" D TBR ;Requesitioner
I T="N" D NUM ;Numeric
I T="$" D DOL ;Dollar value
I T="A" D ALP ;Alpha
I T="AN" D AN ;Alpha/Numeric
I $G(E)=1 D
.D HP ;Help msg
E D
.D SV ;Save
;I F="BCD" B
Q
DT(X,E,F) ;EP;date
;X-Entry to validate E-Error flag F-Field or line tag name
I X="" D
.D CL
E D
.I F'="DTR" S %DT="F"
.S %DT="T"_$G(%DT)
.D ^%DT
.I Y<0 D
..S E=-1
..D HP
.E D
..D SV
Q
CL ;
N Z S Z="D "_F_"^ASUJCLER" X Z Q
SV ;Save
N Z S Z="D "_F_"^ASUJSAVE(.X)" X Z Q
HP ;Help
N Z S Z="D "_F_"^ASUJHELP" S:F="VAL" Z=Z_$S($G(ASUT("TRCD"))?1N.1A:"(1)",1:"(0)") X Z Q
TBF ;Finance
I F="CAN" D CAN^ASUJVALF(.X) Q
I F="CAT" D CAT^ASUJVALF(.X) Q
I F="SRC",((ASUT("TRCD")="06")!(ASUT("TRCD")="26")) S X="L"
N Z S Z="D "_F_"^ASULDIRF(.X)" X Z S:$G(Y)<0 E=1
Q:$G(ASUT("TYPE"))=0 Q:$G(ASUT("TYPE"))=2 Q:$G(ASUT("TYPE"))>6
I F="SRC" D
.I X=1 D Q
..D:$G(ASUSB)'=1 UNED^DDSUTL("VEN","","",1)
..N Z S Z="PERRY POINT" D VENLKU^ASUJVALF(.Z),VEN^ASUJSAVE(.Z)
.I X=4 D Q
..D:$G(ASUSB)'=1 UNED^DDSUTL("VEN","","",1) ;UNEDITABLE 1or0
..N Z S Z="VA SUPPLY DEPOT" D VENLKU^ASUJVALF(.Z),VEN^ASUJSAVE(.Z)
.D:$G(ASUSB)'=1 UNED^DDSUTL("VEN","","",0) ;EDITABLE
.D VEN^ASUJCLER
Q
TBR ;Requsitioner
N Z S Z="D "_F_"^ASULDIRR(.X)" X Z S:$G(Y)<0 E=1
Q:$G(E)]"" ;WAR 3/2/99 DOESN'T MATTER->Q:$G(E)]""
I F="USR",$G(ASUL(18,"SST","E#"))]"" D REQ^ASULDIRR(.X) S:$G(Y)<0 E=1
Q:$G(E)]"" ;WAR 3/2/99 DOESN'T MATTER->Q:$G(E)]""
I F="SST",$G(ASUL(19,"USR","E#"))]"" D
.S Z=ASUL(19,"USR") D REQ^ASULDIRR(.Z) S:$G(Y)<0 E=1
;B
Q
NUM ;EP Numeric
I F="LTM" D
.I X#.5'=0!(X=0) S E=1
E D
.I X'?1N.N S E=1
Q
I X[".",X=+X Q
I X'?1N.N S E=1
Q
DOL ;EP Dollar
S:X'["." X=X_".00" S:$P(X,".",2)']"" $P(X,".",2)="00" S:$L($P(X,".",2))=1 $P(X,".",2)=$P(X,".",2)_"0"
I $P(X,".",2)'?2N S E=1 Q
I $P(X,".")]"",$P(X,".")'?1N.N S E=2 Q
I X>999999.99 S E=3
Q
ALP ;Alpha/Char
I X'?1A.ANP S E=1
Q
AN ;Alpha/Num
I X'?1AN.AN S E=1
Q
ASUJVALD ; IHS/ITSC/LMH -VALIDATE ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;This routine is called to validate fields
+3 SET ASUV("DDSREFT")=DDSREFT
IF $GET(ASUSB)
DO CKFLD^ASUJBTCH
+4 QUIT
EN(X,E,F,T) ;EP;Validate
+1 ;X-Entry to validate
+2 ;E-Error flag
+3 ;F-Field or line tage name
+4 ;T-Type (If Null, no test)
+5 IF X']""
DO CL
QUIT
+6 KILL E
+7 ;Finance
IF T="F"
DO TBF
+8 ;Requesitioner
IF T="R"
DO TBR
+9 ;Numeric
IF T="N"
DO NUM
+10 ;Dollar value
IF T="$"
DO DOL
+11 ;Alpha
IF T="A"
DO ALP
+12 ;Alpha/Numeric
IF T="AN"
DO AN
+13 IF $GET(E)=1
Begin DoDot:1
+14 ;Help msg
DO HP
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 ;Save
DO SV
End DoDot:1
+17 ;I F="BCD" B
+18 QUIT
DT(X,E,F) ;EP;date
+1 ;X-Entry to validate E-Error flag F-Field or line tag name
+2 IF X=""
Begin DoDot:1
+3 DO CL
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 IF F'="DTR"
SET %DT="F"
+6 SET %DT="T"_$GET(%DT)
+7 DO ^%DT
+8 IF Y<0
Begin DoDot:2
+9 SET E=-1
+10 DO HP
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 DO SV
End DoDot:2
End DoDot:1
+13 QUIT
CL ;
+1 NEW Z
SET Z="D "_F_"^ASUJCLER"
XECUTE Z
QUIT
SV ;Save
+1 NEW Z
SET Z="D "_F_"^ASUJSAVE(.X)"
XECUTE Z
QUIT
HP ;Help
+1 NEW Z
SET Z="D "_F_"^ASUJHELP"
IF F="VAL"
SET Z=Z_$SELECT($GET(ASUT("TRCD"))?1N.1A:"(1)",1:"(0)")
XECUTE Z
QUIT
TBF ;Finance
+1 IF F="CAN"
DO CAN^ASUJVALF(.X)
QUIT
+2 IF F="CAT"
DO CAT^ASUJVALF(.X)
QUIT
+3 IF F="SRC"
IF ((ASUT("TRCD")="06")!(ASUT("TRCD")="26"))
SET X="L"
+4 NEW Z
SET Z="D "_F_"^ASULDIRF(.X)"
XECUTE Z
IF $GET(Y)<0
SET E=1
+5 IF $GET(ASUT("TYPE"))=0
QUIT
IF $GET(ASUT("TYPE"))=2
QUIT
IF $GET(ASUT("TYPE"))>6
QUIT
+6 IF F="SRC"
Begin DoDot:1
+7 IF X=1
Begin DoDot:2
+8 IF $GET(ASUSB)'=1
DO UNED^DDSUTL("VEN","","",1)
+9 NEW Z
SET Z="PERRY POINT"
DO VENLKU^ASUJVALF(.Z)
DO VEN^ASUJSAVE(.Z)
End DoDot:2
QUIT
+10 IF X=4
Begin DoDot:2
+11 ;UNEDITABLE 1or0
IF $GET(ASUSB)'=1
DO UNED^DDSUTL("VEN","","",1)
+12 NEW Z
SET Z="VA SUPPLY DEPOT"
DO VENLKU^ASUJVALF(.Z)
DO VEN^ASUJSAVE(.Z)
End DoDot:2
QUIT
+13 ;EDITABLE
IF $GET(ASUSB)'=1
DO UNED^DDSUTL("VEN","","",0)
+14 DO VEN^ASUJCLER
End DoDot:1
+15 QUIT
TBR ;Requsitioner
+1 NEW Z
SET Z="D "_F_"^ASULDIRR(.X)"
XECUTE Z
IF $GET(Y)<0
SET E=1
+2 ;WAR 3/2/99 DOESN'T MATTER->Q:$G(E)]""
IF $GET(E)]""
QUIT
+3 IF F="USR"
IF $GET(ASUL(18,"SST","E#"))]""
DO REQ^ASULDIRR(.X)
IF $GET(Y)<0
SET E=1
+4 ;WAR 3/2/99 DOESN'T MATTER->Q:$G(E)]""
IF $GET(E)]""
QUIT
+5 IF F="SST"
IF $GET(ASUL(19,"USR","E#"))]""
Begin DoDot:1
+6 SET Z=ASUL(19,"USR")
DO REQ^ASULDIRR(.Z)
IF $GET(Y)<0
SET E=1
End DoDot:1
+7 ;B
+8 QUIT
NUM ;EP Numeric
+1 IF F="LTM"
Begin DoDot:1
+2 IF X#.5'=0!(X=0)
SET E=1
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 IF X'?1N.N
SET E=1
End DoDot:1
+5 QUIT
+6 IF X["."
IF X=+X
QUIT
+7 IF X'?1N.N
SET E=1
+8 QUIT
DOL ;EP Dollar
+1 IF X'["."
SET X=X_".00"
IF $PIECE(X,".",2)']""
SET $PIECE(X,".",2)="00"
IF $LENGTH($PIECE(X,".",2))=1
SET $PIECE(X,".",2)=$PIECE(X,".",2)_"0"
+2 IF $PIECE(X,".",2)'?2N
SET E=1
QUIT
+3 IF $PIECE(X,".")]""
IF $PIECE(X,".")'?1N.N
SET E=2
QUIT
+4 IF X>999999.99
SET E=3
+5 QUIT
ALP ;Alpha/Char
+1 IF X'?1A.ANP
SET E=1
+2 QUIT
AN ;Alpha/Num
+1 IF X'?1AN.AN
SET E=1
+2 QUIT
