ACGSINTG ;IHS/OIRM/DSD/THL,AEF - CHECK INTEGRITY OF EACH CIS ENTRY; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ROUTINE TO CHECK INTEGRITY BETWEEN VARIOUS FIELDS OF EACH CIS ENTRY
;;
EN S X=0,U="^"
F S X=$O(^ACGS(X)) Q:'X I $D(^ACGS(X,"DT")),$D(^("DT1")),$D(^("DT2")),$D(^("DT3")) S ACGDT=^("DT"),ACGDT1=^("DT1"),ACGDT2=^("DT2"),ACGDT3=^("DT3") D
.I $P(ACGDT,U,13)>3,$P(ACGDT3,U,11)'="" W !,X,?10,"SOB" S $P(^ACGS(X,"DT3"),U,11)=""
.I $P(ACGDT3,U,7)="" W !,X,?10,"CICA" S $P(^ACGS(X,"DT3"),U,7)="A"
.I $P(ACGDT,U,12)="" D
..W !,X,?10,$P(ACGDT,U,12,21)
..I $P(ACGDT,U,17)=12 S $P(^ACGS(X,"DT"),U,12)="B" D 20
..I $P(ACGDT,U,17)<12 S $P(^ACGS(X,"DT"),U,12)="A" D 20
.I $P(ACGDT,U,12)="A" D
..I $P(ACGDT,U,17)<12,$P(ACGDT,U,19)<60,$P(ACGDT,U,18)'="" W !,X,?10,$P(ACGDT,U,12,21) S $P(^ACGS(X,"DT"),U,18)="" D 20
..I $P(ACGDT,U,17)=12,$P(ACGDT,U,19)>59 W !,X,?10,$P(ACGDT,U,12,21) S $P(^ACGS(X,"DT"),U,12)="B" S:$P(ACGDT,U,18)="" $P(^ACGS(X,"DT"),U,18)=81 D 20
..I $P(ACGDT,U,17)=12,$P(ACGDT,U,19)=56 W !,X,?10,$P(ACGDT,U,12,21) S $P(^ACGS(X,"DT"),U,17)=1,$P(ACGDT,U,18)=""
..I $P(ACGDT,U,17)=12,$P(ACGDT,U,19)'=56,$P(ACGDT,U,19)<60 W !,X,?10,$P(ACGDT,U,12,21) S $P(^ACGS(X,"DT"),U,17)=10,$P(ACGDT,U,18)=""
.I $P(ACGDT,U,12)'="A" D
..I $P(ACGDT,U,17)="" W !,X,?10,$P(ACGDT,U,12,21) S $P(^ACGS(X,"DT"),U,17)=12,$P(ACGDT,U,18)=81,$P(^ACGS(X,"DT3"),U,7)="C" D 20
..I $P(ACGDT,U,17)=12 D
...I $P(ACGDT,U,18)="" W !,X,?10,$P(ACGDT,U,12,21) S $P(^ACGS(X,"DT"),U,18)=81
...I $P(ACGDT,U,20)<4 W !,X,?10,$P(ACGDT,U,12,21) D 20
.I $P(ACGDT,U,12)="C",$P(ACGDT,U,18)'=71 W !,X,?10,$P(ACGDT,U,12,21) S:$P(ACGDT,U,17)'=12 $P(^ACGS(X,"DT"),U,12)=12 S:$P(ACGDT,U,18)'=71 $P(^ACGS(X,"DT"),U,18)=71 D 20
.S ACG37=$P(^ACGS(X,"DT2"),U,2) I ACG37["-"!($L(ACG37)>7) D
..W !,X,?10,ACG37
..I ACG37["-" S ACG37=$P(ACG37,"-",2) S $P(^ACGS(X,"DT2"),U,2)=ACG37
..I $L(ACG37)>7,$E(ACG37)?1N S ACG37=$E(ACG37,2,8)
..I $L(ACG37)>7,$E(ACG37)="J" S ACG37=$E(ACG37,1,7)
..S:"j"=$E(ACG37) ACG37="J"_$E(ACG37,2,8) S $P(^ACGS(X,"DT2"),U,2)=ACG37
..W !,X,?10,ACG37
.I $P(ACGDT3,U,9)=1,$P(ACGDT3,U,10)="" W !,X,?10,ACG37 S $P(^ACGS(X,"DT3"),U,10)=2
.I $P(ACGDT1,U,5)>100000,$P(ACGDT2,U,10)="" W !,X,?10,"SYN" S $P(^ACGS(X,"DT2"),U,10)=$S($P(^ACGS(X,"DT"),U,18)'=77:1,1:2)
Q
20 S $P(^ACGS(X,"DT"),U,20)=$S($P(^ACGS(X,"DT"),U,12)'="A":4,1:3)
Q
ACGSINTG ;IHS/OIRM/DSD/THL,AEF - CHECK INTEGRITY OF EACH CIS ENTRY; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ROUTINE TO CHECK INTEGRITY BETWEEN VARIOUS FIELDS OF EACH CIS ENTRY
+3 ;;
EN SET X=0
SET U="^"
+1 FOR
SET X=$ORDER(^ACGS(X))
IF 'X
QUIT
IF $DATA(^ACGS(X,"DT"))
IF $DATA(^("DT1"))
IF $DATA(^("DT2"))
IF $DATA(^("DT3"))
SET ACGDT=^("DT")
SET ACGDT1=^("DT1")
SET ACGDT2=^("DT2")
SET ACGDT3=^("DT3")
Begin DoDot:1
+2 IF $PIECE(ACGDT,U,13)>3
IF $PIECE(ACGDT3,U,11)'=""
WRITE !,X,?10,"SOB"
SET $PIECE(^ACGS(X,"DT3"),U,11)=""
+3 IF $PIECE(ACGDT3,U,7)=""
WRITE !,X,?10,"CICA"
SET $PIECE(^ACGS(X,"DT3"),U,7)="A"
+4 IF $PIECE(ACGDT,U,12)=""
Begin DoDot:2
+5 WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
+6 IF $PIECE(ACGDT,U,17)=12
SET $PIECE(^ACGS(X,"DT"),U,12)="B"
DO 20
+7 IF $PIECE(ACGDT,U,17)<12
SET $PIECE(^ACGS(X,"DT"),U,12)="A"
DO 20
End DoDot:2
+8 IF $PIECE(ACGDT,U,12)="A"
Begin DoDot:2
+9 IF $PIECE(ACGDT,U,17)<12
IF $PIECE(ACGDT,U,19)<60
IF $PIECE(ACGDT,U,18)'=""
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
SET $PIECE(^ACGS(X,"DT"),U,18)=""
DO 20
+10 IF $PIECE(ACGDT,U,17)=12
IF $PIECE(ACGDT,U,19)>59
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
SET $PIECE(^ACGS(X,"DT"),U,12)="B"
IF $PIECE(ACGDT,U,18)=""
SET $PIECE(^ACGS(X,"DT"),U,18)=81
DO 20
+11 IF $PIECE(ACGDT,U,17)=12
IF $PIECE(ACGDT,U,19)=56
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
SET $PIECE(^ACGS(X,"DT"),U,17)=1
SET $PIECE(ACGDT,U,18)=""
+12 IF $PIECE(ACGDT,U,17)=12
IF $PIECE(ACGDT,U,19)'=56
IF $PIECE(ACGDT,U,19)<60
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
SET $PIECE(^ACGS(X,"DT"),U,17)=10
SET $PIECE(ACGDT,U,18)=""
End DoDot:2
+13 IF $PIECE(ACGDT,U,12)'="A"
Begin DoDot:2
+14 IF $PIECE(ACGDT,U,17)=""
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
SET $PIECE(^ACGS(X,"DT"),U,17)=12
SET $PIECE(ACGDT,U,18)=81
SET $PIECE(^ACGS(X,"DT3"),U,7)="C"
DO 20
+15 IF $PIECE(ACGDT,U,17)=12
Begin DoDot:3
+16 IF $PIECE(ACGDT,U,18)=""
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
SET $PIECE(^ACGS(X,"DT"),U,18)=81
+17 IF $PIECE(ACGDT,U,20)<4
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
DO 20
End DoDot:3
End DoDot:2
+18 IF $PIECE(ACGDT,U,12)="C"
IF $PIECE(ACGDT,U,18)'=71
WRITE !,X,?10,$PIECE(ACGDT,U,12,21)
IF $PIECE(ACGDT,U,17)'=12
SET $PIECE(^ACGS(X,"DT"),U,12)=12
IF $PIECE(ACGDT,U,18)'=71
SET $PIECE(^ACGS(X,"DT"),U,18)=71
DO 20
+19 SET ACG37=$PIECE(^ACGS(X,"DT2"),U,2)
IF ACG37["-"!($LENGTH(ACG37)>7)
Begin DoDot:2
+20 WRITE !,X,?10,ACG37
+21 IF ACG37["-"
SET ACG37=$PIECE(ACG37,"-",2)
SET $PIECE(^ACGS(X,"DT2"),U,2)=ACG37
+22 IF $LENGTH(ACG37)>7
IF $EXTRACT(ACG37)?1N
SET ACG37=$EXTRACT(ACG37,2,8)
+23 IF $LENGTH(ACG37)>7
IF $EXTRACT(ACG37)="J"
SET ACG37=$EXTRACT(ACG37,1,7)
+24 IF "j"=$EXTRACT(ACG37)
SET ACG37="J"_$EXTRACT(ACG37,2,8)
SET $PIECE(^ACGS(X,"DT2"),U,2)=ACG37
+25 WRITE !,X,?10,ACG37
End DoDot:2
+26 IF $PIECE(ACGDT3,U,9)=1
IF $PIECE(ACGDT3,U,10)=""
WRITE !,X,?10,ACG37
SET $PIECE(^ACGS(X,"DT3"),U,10)=2
+27 IF $PIECE(ACGDT1,U,5)>100000
IF $PIECE(ACGDT2,U,10)=""
WRITE !,X,?10,"SYN"
SET $PIECE(^ACGS(X,"DT2"),U,10)=$SELECT($PIECE(^ACGS(X,"DT"),U,18)'=77:1,1:2)
End DoDot:1
+28 QUIT
20 SET $PIECE(^ACGS(X,"DT"),U,20)=$SELECT($PIECE(^ACGS(X,"DT"),U,12)'="A":4,1:3)
+1 QUIT
