ACGSRQ ;IHS/OIRM/DSD/THL,AEF - CHECK CIS RECORD INTEGRITY; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;THIS ROUTINE AND ITS SEQUENTIAL ROUTINES CHECK CIS RECORD INTEGRITY
;;AS EACH CONTRACT ACTION IS ENTERED OR EDITED
EN D:'$D(ACGQUIT) EN1
EXIT F ACG=0:1:70 S X="ACG"_ACG K @X
K ACGRD
Q
EN1 K ^TMP("ACG",$J)
S ACGRD=0
F S ACGRD=$O(^ACGS("C",ACGRD)) Q:'ACGRD I $D(^ACGS(ACGRD,"IHS")),$P(^("IHS"),U,23)=1 S ACGRDA=0 F S ACGRDA=$O(^ACGS("C",ACGRD,ACGRDA)) Q:'ACGRDA D EN2
Q
EN2 ;XEP;TO CHECK INTEGRITY OF CIS ENTRY
D ^ACGSRQF1
S:'$D(ACGRD)#2 ACGRD=$P(^ACGS(ACGRDA,0),U,3)
S:ACG2="" ACG2=ACGRDA
S ACG=""
S:'$D(^TMP("ACG",$J,"T")) ^TMP("ACG",$J,"T")=0
1 I ACG1'?1U&("DIALSQRCMTUBOGN"'[ACG1) D T S ^TMP("ACG",$J,ACG2,1)="1++"_ACG1_"^W !?5,""Item 1 is required."""
I "DIALS"[ACG1 F ACG=19:1:23,25,27,29:1:32,45,58,63 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals D, I, A, L, or S, Item "_ACG_" is required."""
I "CMR"[ACG1 F ACG=19:1:20,23,58,63 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals C, M, or R, Item "_ACG_" is required."""
I ACG1="Q" F ACG=19,21,23,25,27,58,63 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals Q, Item "_ACG_" is required."""
I "BGNO"[ACG1 F ACG=22,23,25,27,56:1:58 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals B, G, N or O, Item "_ACG_" is required."""
I ACG1="B" F ACG=19,20,23,25,30 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals B, Item "_ACG_" is required."""
I ACG1="O" F ACG=23,27:1:27 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals O, Item "_ACG_" is required."""
I "TU"[ACG1 F ACG=23,45,56,57,63 S X=@("ACG"_ACG) I X="" D T S ^TMP("ACG",$J,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals T or U, Item "_ACG_" is required."""
2 I "BGNO"[ACG1,$L(ACG2)<9!($L(ACG2)>14) D T S ^TMP("ACG",$J,ACG2,2)="2++"_ACG2_"^W !?5,""Item 2 is required and must be 9-14 characters in length."""
3 I "BGNO"[ACG1,$L(ACG3)<8!($L(ACG3)>14) D T S ^TMP("ACG",$J,ACG2,3)="1++"_ACG1_";3++"_ACG3_"^W !?5,""Item 3 is required and must be 8-14 characters in length."""
4 I "ADILSG"[ACG1,ACG4=""!(ACG4'?3N)!($S(ACG4'="":'$D(^ACGPO("C",ACG4)),1:1)) D
.D T S ^TMP("ACG",$J,ACG2,4)="1++"_ACG1_";4++"_ACG4_"^W !?5,""Item 4 is required and must be numeric, 3 characters in length"",!?5,""and correspond to a valid Contracting Office number."""
5 I "ADILSBGQ"[ACG1,ACG5="" D T S ^TMP("ACG",$J,ACG2,5)="1++"_ACG1_";5++"_ACG5_"^W !?5,""Item 5 is required and must be no more than 40 characters in length."""
6 I "ADILSBGQ"[ACG1,ACG6=""!($L(ACG6)>30) D T S ^TMP("ACG",$J,ACG2,6)="1++"_ACG1_";6++"_ACG6_"^W !?5,""Item 6 is required and must be no more than 30 characters in length."""
7 I "ADILSBGQ"[ACG1,ACG7=""!($L(ACG7)>23) D T S ^TMP("ACG",$J,ACG2,7)="1++"_ACG1_";7++"_ACG7_"^W !?5,""Item 7 is required and must be no more than 23 characters in length."""
8 I "ADILSBGQ"[ACG1,ACG8=""!($L(ACG8)>19) D T S ^TMP("ACG",$J,ACG2,8)="1++"_ACG1_";8++"_ACG8_"^W !?5,""Item 8 is required and must be a valid state or country name, no more than 19 characters in length."""
9 I "ADILSBGQ"[ACG1,ACG9=""!($L(ACG9)>5) D T S ^TMP("ACG",$J,ACG2,9)="1++"_ACG1_";9++"_ACG9_"^W !?5,""Item 9 is required and must be the 5 digit ZIP code."""
10 I "ADILSBQ"[ACG1,ACG10=""!(ACG10'?3N) D T S ^TMP("ACG",$J,ACG2,10)="1++"_ACG1_";10++"_ACG10_"^W !?5,""Item 10 is required and must be three numeric digits."",!?5,""Use '099' for multiple congressional districts."""
11 I "ADILS"[ACG1,ACG11=""!("12"'[$E(ACG11))!($E(ACG11)=1&($L(ACG11)'=12))!($E(ACG11)=1&($E(ACG11,11,12)'?1U1N))!($E(ACG11)=2&($L(ACG11)'=10)) D
.D T S ^TMP("ACG",$J,ACG2,11)="1++"_ACG1_";11++"_ACG11_"^W !?5,""Item 11 is required and must be 10 or 12 characters in length."",!?5,""If the first character is '1' characters 11 and 12 are required."""
D ^ACGSRQ1
Q
T I '$D(^TMP("ACG",$J,ACG2)) S ^TMP("ACG",$J,"T")=^TMP("ACG",$J,"T")+1 W:'$D(ZTQUEUED)&($E(IOST,1,2)="C-") "."
Q
ACGSRQ ;IHS/OIRM/DSD/THL,AEF - CHECK CIS RECORD INTEGRITY; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;THIS ROUTINE AND ITS SEQUENTIAL ROUTINES CHECK CIS RECORD INTEGRITY
+3 ;;AS EACH CONTRACT ACTION IS ENTERED OR EDITED
EN IF '$DATA(ACGQUIT)
DO EN1
EXIT FOR ACG=0:1:70
SET X="ACG"_ACG
KILL @X
+1 KILL ACGRD
+2 QUIT
EN1 KILL ^TMP("ACG",$JOB)
+1 SET ACGRD=0
+2 FOR
SET ACGRD=$ORDER(^ACGS("C",ACGRD))
IF 'ACGRD
QUIT
IF $DATA(^ACGS(ACGRD,"IHS"))
IF $PIECE(^("IHS"),U,23)=1
SET ACGRDA=0
FOR
SET ACGRDA=$ORDER(^ACGS("C",ACGRD,ACGRDA))
IF 'ACGRDA
QUIT
DO EN2
+3 QUIT
EN2 ;XEP;TO CHECK INTEGRITY OF CIS ENTRY
+1 DO ^ACGSRQF1
+2 IF '$DATA(ACGRD)#2
SET ACGRD=$PIECE(^ACGS(ACGRDA,0),U,3)
+3 IF ACG2=""
SET ACG2=ACGRDA
+4 SET ACG=""
+5 IF '$DATA(^TMP("ACG",$JOB,"T"))
SET ^TMP("ACG",$JOB,"T")=0
1 IF ACG1'?1U&("DIALSQRCMTUBOGN"'[ACG1)
DO T
SET ^TMP("ACG",$JOB,ACG2,1)="1++"_ACG1_"^W !?5,""Item 1 is required."""
+1 IF "DIALS"[ACG1
FOR ACG=19:1:23,25,27,29:1:32,45,58,63
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals D, I, A, L, or S, Item "_ACG_" is required."""
+2 IF "CMR"[ACG1
FOR ACG=19:1:20,23,58,63
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals C, M, or R, Item "_ACG_" is required."""
+3 IF ACG1="Q"
FOR ACG=19,21,23,25,27,58,63
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals Q, Item "_ACG_" is required."""
+4 IF "BGNO"[ACG1
FOR ACG=22,23,25,27,56:1:58
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals B, G, N or O, Item "_ACG_" is required."""
+5 IF ACG1="B"
FOR ACG=19,20,23,25,30
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals B, Item "_ACG_" is required."""
+6 IF ACG1="O"
FOR ACG=23,27:1:27
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals O, Item "_ACG_" is required."""
+7 IF "TU"[ACG1
FOR ACG=23,45,56,57,63
SET X=@("ACG"_ACG)
IF X=""
DO T
SET ^TMP("ACG",$JOB,ACG2,1,ACG)=ACG_"++"_@("ACG"_ACG)_"^W !?5,""If Item 1 equals T or U, Item "_ACG_" is required."""
2 IF "BGNO"[ACG1
IF $LENGTH(ACG2)<9!($LENGTH(ACG2)>14)
DO T
SET ^TMP("ACG",$JOB,ACG2,2)="2++"_ACG2_"^W !?5,""Item 2 is required and must be 9-14 characters in length."""
3 IF "BGNO"[ACG1
IF $LENGTH(ACG3)<8!($LENGTH(ACG3)>14)
DO T
SET ^TMP("ACG",$JOB,ACG2,3)="1++"_ACG1_";3++"_ACG3_"^W !?5,""Item 3 is required and must be 8-14 characters in length."""
4 IF "ADILSG"[ACG1
IF ACG4=""!(ACG4'?3N)!($SELECT(ACG4'="":'$DATA(^ACGPO("C",ACG4)),1:1))
Begin DoDot:1
+1 DO T
SET ^TMP("ACG",$JOB,ACG2,4)="1++"_ACG1_";4++"_ACG4_"^W !?5,""Item 4 is required and must be numeric, 3 characters in length"",!?5,""and correspond to a valid Contracting Office number."""
End DoDot:1
5 IF "ADILSBGQ"[ACG1
IF ACG5=""
DO T
SET ^TMP("ACG",$JOB,ACG2,5)="1++"_ACG1_";5++"_ACG5_"^W !?5,""Item 5 is required and must be no more than 40 characters in length."""
6 IF "ADILSBGQ"[ACG1
IF ACG6=""!($LENGTH(ACG6)>30)
DO T
SET ^TMP("ACG",$JOB,ACG2,6)="1++"_ACG1_";6++"_ACG6_"^W !?5,""Item 6 is required and must be no more than 30 characters in length."""
7 IF "ADILSBGQ"[ACG1
IF ACG7=""!($LENGTH(ACG7)>23)
DO T
SET ^TMP("ACG",$JOB,ACG2,7)="1++"_ACG1_";7++"_ACG7_"^W !?5,""Item 7 is required and must be no more than 23 characters in length."""
8 IF "ADILSBGQ"[ACG1
IF ACG8=""!($LENGTH(ACG8)>19)
DO T
SET ^TMP("ACG",$JOB,ACG2,8)="1++"_ACG1_";8++"_ACG8_"^W !?5,""Item 8 is required and must be a valid state or country name, no more than 19 characters in length."""
9 IF "ADILSBGQ"[ACG1
IF ACG9=""!($LENGTH(ACG9)>5)
DO T
SET ^TMP("ACG",$JOB,ACG2,9)="1++"_ACG1_";9++"_ACG9_"^W !?5,""Item 9 is required and must be the 5 digit ZIP code."""
10 IF "ADILSBQ"[ACG1
IF ACG10=""!(ACG10'?3N)
DO T
SET ^TMP("ACG",$JOB,ACG2,10)="1++"_ACG1_";10++"_ACG10_"^W !?5,""Item 10 is required and must be three numeric digits."",!?5,""Use '099' for multiple congressional districts."""
11 IF "ADILS"[ACG1
IF ACG11=""!("12"'[$EXTRACT(ACG11))!($EXTRACT(ACG11)=1&($LENGTH(ACG11)'=12))!($EXTRACT(ACG11)=1&($EXTRACT(ACG11,11,12)'?1U1N))!($EXTRACT(ACG11)=2&($LENGTH(ACG11)'=10))
Begin DoDot:1
+1 DO T
SET ^TMP("ACG",$JOB,ACG2,11)="1++"_ACG1_";11++"_ACG11_"^W !?5,""Item 11 is required and must be 10 or 12 characters in length."",!?5,""If the first character is '1' characters 11 and 12 are required."""
End DoDot:1
+2 DO ^ACGSRQ1
+3 QUIT
T IF '$DATA(^TMP("ACG",$JOB,ACG2))
SET ^TMP("ACG",$JOB,"T")=^TMP("ACG",$JOB,"T")+1
IF '$DATA(ZTQUEUED)&($EXTRACT(IOST,1,2)="C-")
WRITE "."
+1 QUIT
