- ACGS2 ;IHS/OIRM/DSD/THL,AEF - INPUT TRANSFORM FOR CONTRACT NUMBER; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;ROUTINE TO CHECK THE INTEGRITY OF THE CONTRACT NUMBER
- 2 ;EP;INPUT TRANSFORM FOR CONTRACT NUMBER
- S:'$D(ACG4) ACG4=$P(^ACGPARA(ACGPODA,0),U,3)
- S ACG1=+^ACGS(DA,"DT")
- I 'ACG1 D TPA Q
- I '$D(^ACGTPA(ACG1,0)) D TPA Q
- S ACG1=$P(^ACGTPA(ACG1,0),U)
- I $E(ACG1)="P" W !!,"For 'P' actions use the appropriate PURCHASE ORDER number." Q
- I ACG1="G" D Q
- .I $E(X)="G" D Q
- ..I $E(X,1,2)'="GS" W !!,"Positions 1 & 2 of GSA contract number must be 'GS'." K X Q
- ..I $E(X,3,4)'?2N W !!,"Positions 3 & 4 of GSA contract number must be numeric." K X Q
- ..I "FK"'[$E(X,5) W !!,"Position 5 of GSA contract number must be 'F' or 'K'." K X Q
- ..I $E(X,5)="F",$L(X)'=10 W !!,"If position 5 of GSA contract number is 'F' the GSA contract number must be 10",!,"characters in length." K X Q
- ..I $E(X,5)="K",$L(X)'=14!($E(X,10)'="S") W !!,"If position 5 of GSA contract number is 'K' the GSA contract number must be 14",!,"characters in length and the 10th position must be an 'S'." K X Q
- .I $E(X)="V" Q
- .E W !!,"You must enter the GSA or VA contract number for the Federal Supply Contract." K X Q
- I $E(ACG1)'="P" D Q
- .I "OG"'[ACG1,$D(^ACGS("B",X)) W !!,"This contract number has already been assigned and duplicate numbers are not",!,"allowed." K X Q
- .I $E(X,1,3)'=ACG4 W !!,"The first 3 characters must be the same as the contract office number." K X Q
- .I X'?12N W !!,"The contract number must be 12 numeric characters in length." K X Q
- .I "ADILS"[ACG1,$E(X,10,12)'="000" W !!,"If Type of Procurement Action is A, D, I, L or S, positions 10-12 of the",!,"contract number must be '000'." K X Q
- .I "ADILS"'[ACG1,+$E(X,10,12)'>0 W !!,"If Type of Procurement Action is not A, D, I, L or S, positions 10-12 of the",!,"contract number must be greater than '000'." K X Q
- Q
- TPA ;TPA MESSAGE
- W !!,"Enter the TYPE OF PROCUREMENT ACTION before entering the contract number." K X
- Q
- ACGS2 ;IHS/OIRM/DSD/THL,AEF - INPUT TRANSFORM FOR CONTRACT NUMBER; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;ROUTINE TO CHECK THE INTEGRITY OF THE CONTRACT NUMBER
- 2 ;EP;INPUT TRANSFORM FOR CONTRACT NUMBER
- +1 IF '$DATA(ACG4)
- SET ACG4=$PIECE(^ACGPARA(ACGPODA,0),U,3)
- +2 SET ACG1=+^ACGS(DA,"DT")
- +3 IF 'ACG1
- DO TPA
- QUIT
- +4 IF '$DATA(^ACGTPA(ACG1,0))
- DO TPA
- QUIT
- +5 SET ACG1=$PIECE(^ACGTPA(ACG1,0),U)
- +6 IF $EXTRACT(ACG1)="P"
- WRITE !!,"For 'P' actions use the appropriate PURCHASE ORDER number."
- QUIT
- +7 IF ACG1="G"
- Begin DoDot:1
- +8 IF $EXTRACT(X)="G"
- Begin DoDot:2
- +9 IF $EXTRACT(X,1,2)'="GS"
- WRITE !!,"Positions 1 & 2 of GSA contract number must be 'GS'."
- KILL X
- QUIT
- +10 IF $EXTRACT(X,3,4)'?2N
- WRITE !!,"Positions 3 & 4 of GSA contract number must be numeric."
- KILL X
- QUIT
- +11 IF "FK"'[$EXTRACT(X,5)
- WRITE !!,"Position 5 of GSA contract number must be 'F' or 'K'."
- KILL X
- QUIT
- +12 IF $EXTRACT(X,5)="F"
- IF $LENGTH(X)'=10
- WRITE !!,"If position 5 of GSA contract number is 'F' the GSA contract number must be 10",!,"characters in length."
- KILL X
- QUIT
- +13 IF $EXTRACT(X,5)="K"
- IF $LENGTH(X)'=14!($EXTRACT(X,10)'="S")
- WRITE !!,"If position 5 of GSA contract number is 'K' the GSA contract number must be 14",!,"characters in length and the 10th position must be an 'S'."
- KILL X
- QUIT
- End DoDot:2
- QUIT
- +14 IF $EXTRACT(X)="V"
- QUIT
- +15 IF '$TEST
- WRITE !!,"You must enter the GSA or VA contract number for the Federal Supply Contract."
- KILL X
- QUIT
- End DoDot:1
- QUIT
- +16 IF $EXTRACT(ACG1)'="P"
- Begin DoDot:1
- +17 IF "OG"'[ACG1
- IF $DATA(^ACGS("B",X))
- WRITE !!,"This contract number has already been assigned and duplicate numbers are not",!,"allowed."
- KILL X
- QUIT
- +18 IF $EXTRACT(X,1,3)'=ACG4
- WRITE !!,"The first 3 characters must be the same as the contract office number."
- KILL X
- QUIT
- +19 IF X'?12N
- WRITE !!,"The contract number must be 12 numeric characters in length."
- KILL X
- QUIT
- +20 IF "ADILS"[ACG1
- IF $EXTRACT(X,10,12)'="000"
- WRITE !!,"If Type of Procurement Action is A, D, I, L or S, positions 10-12 of the",!,"contract number must be '000'."
- KILL X
- QUIT
- +21 IF "ADILS"'[ACG1
- IF +$EXTRACT(X,10,12)'>0
- WRITE !!,"If Type of Procurement Action is not A, D, I, L or S, positions 10-12 of the",!,"contract number must be greater than '000'."
- KILL X
- QUIT
- End DoDot:1
- QUIT
- +22 QUIT
- TPA ;TPA MESSAGE
- +1 WRITE !!,"Enter the TYPE OF PROCUREMENT ACTION before entering the contract number."
- KILL X
- +2 QUIT
