- ACGSRQ4 ;IHS/OIRM/DSD/THL,AEF - CHECK CIS RECORD INTEGRITY CONT'D; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;CHECK CIS RECORD INTEGRITY CONT'D
- EN ;EP;TO CHECK INTEGRITY OF CIS ENTRY
- 27 I "ADILS"[ACG1,ACG27="" D T S ^TMP("ACG",$J,ACG2,27)="27++"_ACG27_";++"_"^W !?5,""Item 27 is required."""
- I $E(ACG27)="A",ACG1'="G" D T S ^TMP("ACG",$J,ACG2,27,1)="27++"_ACG27_";1++"_ACG1_"^W !?5,""If Item 27 begins with A, Item 1 must equal G."""
- I ACG27]"" S X=$O(^ACGPPC("B",ACG27,0)) I X,$D(^ACGPPC(X,0)) S X=$P(^ACGPPC(X,0),U,4),ACG27DA=$S(X=1:1,1:2)
- E S ACG27DA="NOT ENTERED" D T S ^TMP("ACG",$J,ACG2,27)="27++"_ACG27_";++"_"^W !?5,""Item 27 is required."""
- I "ADILS"[ACG1,ACG27DA,ACG27DA'=ACG16 D T S ^TMP("ACG",$J,ACG2,27,16)="27++"_ACG27_";16++"_ACG16_"^W !?5,""Item 27 must be from an A&A group compatible with Item 16."""
- 28 I "ADILSOQG"[ACG1 D
- .I '+ACG28 D R28
- .I ACG28="" D T S ^TMP("ACG",$J,ACG2,1,28)="1++"_ACG1_";28++"_ACG28_"^W !?5,""If Item 1 equals A, D, I, L, S, O, Q or G, Item 28 is required."",!?5,""Check GEOGRAPHICAL LOCATION to ensure that STATE and PLACE CODE are entered."""
- .I ACG28'="",$E(ACG28,1,7)'?7N D T S ^TMP("ACG",$J,ACG2,28)="28++"_ACG28_"^W !?5,""Item 28 must begin with the State code followed by the 5-digit Place Code"",!?5,""followed by the name of the location where service is performed."""
- 29 ;
- 30 I "ADILSB"[ACG1,"12"'[ACG30 D
- .S $P(^ACGS(ACGRDA,"DT1"),U,9)=$S(ACG30["Y":1,1:2),ACG30=$P(^("DT1"),U,9)
- .I ACG30=1,"A1A2A3"'[ACG13 D
- ..D T S ^TMP("ACG",$J,ACG2,30,13)="30++"_ACG30_";13++"_ACG13_"^W !?5,""If Item 30 equals 1, Item 13 must be A1, A2 or A3."""
- 31 I "ADILS"[ACG1 D
- .I ACG51=1,ACG31'="" D T S ^TMP("ACG",$J,ACG2,31,51)="51++"_ACG51_";31++"_ACG31_"^W !?5,""If Item 51 equals 1, Item 31 must be null."""
- .I "ABCD"[ACG31,"E1E2"'[ACG13 D T S ^TMP("ACG",$J,ACG2,31,13)="31++"_ACG31_";13++"_ACG13_"^W !?5,""If Item 31 equals A, B, C or D, Item 13 must equal E1 or E2."""
- 32 ;
- 33 ;
- 34 I "ADILSMRC"[ACG1 D
- .I ACG34="" D T S ^TMP("ACG",$J,ACG2,1,34)="1++"_ACG1_";34++"_ACG34_"^W !?5,""If Item 1 equals A, D, I, L, S, O, Q or G, Item 34 is required."""
- .I ACG34'="",ACG34>ACG23 D T S ^TMP("ACG",$J,ACG2,34,23)="34++"_ACG34_";23++"_ACG23_"^W !?5,""If Item 1 not equal B, O, P or Q, Item 34 must be < or = Item 23"""
- 35 I "ADILS"[ACG1,ACG16=1,ACG35="" D T S ^TMP("ACG",$J,ACG2,1,35,16)="1++"_ACG1_";16++"_ACG16_";35++"_ACG35_"^W !?5,""If Item 1 is A, D, I, L, or S, and Item 16 equals 1, Item 35 must not be null."""
- 36 ;
- 37 I "ADILSCMR"[ACG1,+ACG26,ACG37="" D R37 D
- .I ACG37="" D T S ^TMP("ACG",$J,ACG2,1,26,37)="1++"_ACG1_";26++"_ACG26_";37++"_ACG37_"^W !?5,""If Item 1 equals A, C, D, I, L, M, R, or S, and Item 26 is not 0,"",!?5,""Item 37 must not be null."""
- 38 ;
- 39 ;
- 40 ;
- 41 ;
- 42 ;
- 43 ;
- 44 ;
- D ^ACGSRQ5
- 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
- R28 S ACG28=$P(^ACGS(ACGRD,"DT1"),U,7),$P(^ACGS(ACGRDA,"DT1"),U,7)=ACG28
- Q
- R37 S ACG37=$P(^ACGS(ACGRD,"DT2"),U,2)
- I ACG37'="",$L(ACG37)=7 S $P(^ACGS(ACGRDA,"DT2"),U,2)=ACG37
- E S ACG37=""
- Q
- ACGSRQ4 ;IHS/OIRM/DSD/THL,AEF - CHECK CIS RECORD INTEGRITY CONT'D; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;CHECK CIS RECORD INTEGRITY CONT'D
- EN ;EP;TO CHECK INTEGRITY OF CIS ENTRY
- 27 IF "ADILS"[ACG1
- IF ACG27=""
- DO T
- SET ^TMP("ACG",$JOB,ACG2,27)="27++"_ACG27_";++"_"^W !?5,""Item 27 is required."""
- +1 IF $EXTRACT(ACG27)="A"
- IF ACG1'="G"
- DO T
- SET ^TMP("ACG",$JOB,ACG2,27,1)="27++"_ACG27_";1++"_ACG1_"^W !?5,""If Item 27 begins with A, Item 1 must equal G."""
- +2 IF ACG27]""
- SET X=$ORDER(^ACGPPC("B",ACG27,0))
- IF X
- IF $DATA(^ACGPPC(X,0))
- SET X=$PIECE(^ACGPPC(X,0),U,4)
- SET ACG27DA=$SELECT(X=1:1,1:2)
- +3 IF '$TEST
- SET ACG27DA="NOT ENTERED"
- DO T
- SET ^TMP("ACG",$JOB,ACG2,27)="27++"_ACG27_";++"_"^W !?5,""Item 27 is required."""
- +4 IF "ADILS"[ACG1
- IF ACG27DA
- IF ACG27DA'=ACG16
- DO T
- SET ^TMP("ACG",$JOB,ACG2,27,16)="27++"_ACG27_";16++"_ACG16_"^W !?5,""Item 27 must be from an A&A group compatible with Item 16."""
- 28 IF "ADILSOQG"[ACG1
- Begin DoDot:1
- +1 IF '+ACG28
- DO R28
- +2 IF ACG28=""
- DO T
- SET ^TMP("ACG",$JOB,ACG2,1,28)="1++"_ACG1_";28++"_ACG28_"^W !?5,""If Item 1 equals A, D, I, L, S, O, Q or G, Item 28 is required."",!?5,""Check GEOGRAPHICAL LOCATION to ensure that STATE and PLACE CODE are entered."""
- +3 IF ACG28'=""
- IF $EXTRACT(ACG28,1,7)'?7N
- DO T
- SET ^TMP("ACG",$JOB,ACG2,28)="28++"_ACG28_"^W !?5,""Item 28 must begin with the State code followed by the 5-digit Place Code"",!?5,""followed by the name of the location where service is performed."""
- End DoDot:1
- 29 ;
- 30 IF "ADILSB"[ACG1
- IF "12"'[ACG30
- Begin DoDot:1
- +1 SET $PIECE(^ACGS(ACGRDA,"DT1"),U,9)=$SELECT(ACG30["Y":1,1:2)
- SET ACG30=$PIECE(^("DT1"),U,9)
- +2 IF ACG30=1
- IF "A1A2A3"'[ACG13
- Begin DoDot:2
- +3 DO T
- SET ^TMP("ACG",$JOB,ACG2,30,13)="30++"_ACG30_";13++"_ACG13_"^W !?5,""If Item 30 equals 1, Item 13 must be A1, A2 or A3."""
- End DoDot:2
- End DoDot:1
- 31 IF "ADILS"[ACG1
- Begin DoDot:1
- +1 IF ACG51=1
- IF ACG31'=""
- DO T
- SET ^TMP("ACG",$JOB,ACG2,31,51)="51++"_ACG51_";31++"_ACG31_"^W !?5,""If Item 51 equals 1, Item 31 must be null."""
- +2 IF "ABCD"[ACG31
- IF "E1E2"'[ACG13
- DO T
- SET ^TMP("ACG",$JOB,ACG2,31,13)="31++"_ACG31_";13++"_ACG13_"^W !?5,""If Item 31 equals A, B, C or D, Item 13 must equal E1 or E2."""
- End DoDot:1
- 32 ;
- 33 ;
- 34 IF "ADILSMRC"[ACG1
- Begin DoDot:1
- +1 IF ACG34=""
- DO T
- SET ^TMP("ACG",$JOB,ACG2,1,34)="1++"_ACG1_";34++"_ACG34_"^W !?5,""If Item 1 equals A, D, I, L, S, O, Q or G, Item 34 is required."""
- +2 IF ACG34'=""
- IF ACG34>ACG23
- DO T
- SET ^TMP("ACG",$JOB,ACG2,34,23)="34++"_ACG34_";23++"_ACG23_"^W !?5,""If Item 1 not equal B, O, P or Q, Item 34 must be < or = Item 23"""
- End DoDot:1
- 35 IF "ADILS"[ACG1
- IF ACG16=1
- IF ACG35=""
- DO T
- SET ^TMP("ACG",$JOB,ACG2,1,35,16)="1++"_ACG1_";16++"_ACG16_";35++"_ACG35_"^W !?5,""If Item 1 is A, D, I, L, or S, and Item 16 equals 1, Item 35 must not be null."""
- 36 ;
- 37 IF "ADILSCMR"[ACG1
- IF +ACG26
- IF ACG37=""
- DO R37
- Begin DoDot:1
- +1 IF ACG37=""
- DO T
- SET ^TMP("ACG",$JOB,ACG2,1,26,37)="1++"_ACG1_";26++"_ACG26_";37++"_ACG37_"^W !?5,""If Item 1 equals A, C, D, I, L, M, R, or S, and Item 26 is not 0,"",!?5,""Item 37 must not be null."""
- End DoDot:1
- 38 ;
- 39 ;
- 40 ;
- 41 ;
- 42 ;
- 43 ;
- 44 ;
- +1 DO ^ACGSRQ5
- +2 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
- R28 SET ACG28=$PIECE(^ACGS(ACGRD,"DT1"),U,7)
- SET $PIECE(^ACGS(ACGRDA,"DT1"),U,7)=ACG28
- +1 QUIT
- R37 SET ACG37=$PIECE(^ACGS(ACGRD,"DT2"),U,2)
- +1 IF ACG37'=""
- IF $LENGTH(ACG37)=7
- SET $PIECE(^ACGS(ACGRDA,"DT2"),U,2)=ACG37
- +2 IF '$TEST
- SET ACG37=""
- +3 QUIT