- 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
