ACGSIE ;IHS/OIRM/DSD/THL,AEF - INTERRELATIONSHIP EDITS; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ROUTINE TO CHECK THE INTEGRITY BETWEEN VARIOUS FIELDS WITHIN EACH
;;CONTRACT ACTION
EXIT ;
Q
12 ;G:$D(^ACGS(DA,"SP")) SP12
Q N ACGI,ACG1,ACG13,ACG17,ACG19
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
1213 G:ACG13=""!(ACG19="")!(ACG13'="A1")!(ACG19<59)!(ACG19>60) 1217
I ACG13="A1",ACG19="60",Y="B" Q
I ACG13="A1",ACG19="59",Y="A" Q
1217 G:ACG17="" 1219
I "BOTU"'[$E(ACG1),"ABCDEFGHIJ"[$E(ACG17,2),Y="A" Q
I "BOTU"'[$E(ACG1),ACG17="4K",Y'="A"
1219 Q:ACG19=""
I ACG19<60,Y="A" Q
I ACG19>59,Y'="A"
G EXIT
SP12 Q:"^15^17^"'[(U_+^ACGS(DA,"DT")_U) S ACG306=$P(^("SP"),U,6)
Q:ACG306=1!(ACG306=5)
I ACG306>1,ACG306<5,Y="A"
G EXIT
13 N ACGI,ACG12,ACG19
F ACGI=12,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
S ACG13=$P(^AUTTTOB(+Y,0),U)
Q:ACG19=""
I 5960[ACG19,ACG13="A1" Q
I "50525355"[ACG19,"A2A3C5"[ACG13 Q
I "505253555960"'[ACG19
G EXIT
16 N ACGI
F ACGI=271 S ACG="ACG"_ACGI D @ACG^ACGSIE1
Q:ACG271=""
I ACG271=1,Y=1 Q
I ACG271=2,Y=2
G EXIT
17 N ACGI,ACG12,ACG18,ACG19,ACG27
F ACGI=12,18,19,27 S ACG="ACG"_ACGI D @ACG^ACGSIE1
S ACG17=$P(^ACGSP(Y,0),U)
1712 G:ACG12="" 1719
I ACG12'="A",ACG17="4K" Q
I ACG12="A",ACG17'="4K"
1719 Q:ACG19<59!(ACG19>60)
I ACG19=59,ACG17="4J" Q
I ACG19=60,ACG17="4K" Q
G EXIT
18 N ACGI,ACG17,ACG19
F ACGI=1,17,19,62 S ACG="ACG"_ACGI D @ACG^ACGSIE1
S ACG18=$P(^ACGFAO(Y,0),U)
I ACG62="C",ACG18=81 Q
I ACG17="4K",ACG19=60,ACG18=81 Q
I ACG17="4K",ACG18>69 Q
I ACG17'="4K"
G EXIT
19 N ACGI,ACG12
F ACGI=1,12,13,17 S ACG="ACG"_ACGI D @ACG^ACGSIE1
S ACG19=$P(^ACGEOC(Y,0),U)
Q:ACG12=""&(ACG13="")
I ACG12]"" D Q:'$T
.I "BCD"[ACG12,ACG19>59 Q
.I ACG12="A",ACG17'="4J",ACG19<60 Q
.I ACG12="A",ACG17="4J",ACG19<60,(ACG19>49&(ACG19<56))!(ACG19>57) Q
I ACG13]"" D
.I ACG13="A1",ACG19=59!(ACG19=60) Q
.I "A2A3C5"[ACG13,50525355[ACG19 Q
.I "A1A2A3C5"'[ACG13,505253555960'[ACG19 Q
G EXIT
20 N ACGI,ACG13,ACG17
F ACGI=1,12,13,17 S ACG="ACG"_ACGI D @ACG^ACGSIE1
S ACG20=$P(^ACGMOC(Y,0),U)
2012 G:ACG12="" 2017
I ACG12="A",ACG20<4 G 2017
I ACG12'="A",ACG20<4 G EXIT
2017 G:ACG17="" 2019
I ACG17="4A",ACG20<3 G EXIT
I ACG17="4K",ACG20=4 G EXIT
I ACG17'="4K",ACG20<4
G EXIT
2019 Q
21 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
26 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
27 N ACGI
F ACGI=1,13,16,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G:ACG16="" EXIT
;I ACG16=$P(^ACGPPC(+Y,0),U,4)
G EXIT
30 N ACGI
F ACGI=1,13 S ACG="ACG"_ACGI D @ACG^ACGSIE1
I "A1A2A3"'[ACG13,Y=1 I 0 G EXIT
I "A1A2A3"[ACG13,Y=1!(Y=2) G EXIT
I "A1A2A3"'[ACG13,Y=2 G EXIT
G EXIT
31 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
34 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
45 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
52 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
56 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
62 Q N ACGI
F ACGI=1,13,17,19 S ACG="ACG"_ACGI D @ACG^ACGSIE1
G EXIT
63 Q N ACGI
D ACG27,ACG53
F ACGI=1,13,17,19,27,53 S ACG="ACG"_ACGI D @ACG^ACGSIE1
I "A1A2A3B1B2"'[ACG13 Q
I '$D(ACG27(ACG27))&'$D(ACG53(ACG53)) Q
I Y=1 Q
G EXIT
66 N ACGI
D ACG13^ACGSIE1
I "^A1^A2^A3^"[(U_ACG13_U) Q
I "^A1^A2^A3^"'[(U_ACG13_U),X="" Q
G EXIT
67 N ACGI
D ACG13^ACGSIE1
I ACG13="C5" Q
E K X
G EXIT
68 N ACGI
D ACG13^ACGSIE1
I ACG13="C5" Q
E K X
G EXIT
69 N ACGI
D ACG13^ACGSIE1
I ACG13="C5" Q
E K X
G EXIT
SP17 D ACGSP17
Q:ACGSP17="A1" I Y=2!(Y=4)!(Y=5)
G EXIT
ACGSP17 S ACGSP17=$P(^ACGS(DA,"SP"),U,XX)
Q
ACG53 F X=1521,1522,1531,1541,1542,1611,1622,1623,1629,1711,1721,1731,1741,1742,1743,1751,1752,1761,1771,1781,1791,1793,1794,1795,1796,1799 S ACG53(X)=""
Q
ACG27 F X=11:1:19,21:1:24,29,30 S ACG27("C1"_X)=""
F X=11,13:1:16,19 S ACG27("C2"_X)=""
F X="G004","J099","J999","K099","Q201","R404","R406","R497","S205" S ACG27(X)=""
F X=2,4,6,8,9 S ACG27("T00"_X)=""
F X="T014",6505,7045,7110,7510 S ACG27(X)=""
Q
ACGSIE ;IHS/OIRM/DSD/THL,AEF - INTERRELATIONSHIP EDITS; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ROUTINE TO CHECK THE INTEGRITY BETWEEN VARIOUS FIELDS WITHIN EACH
+3 ;;CONTRACT ACTION
EXIT ;
+1 QUIT
12 ;G:$D(^ACGS(DA,"SP")) SP12
+1 QUIT
NEW ACGI,ACG1,ACG13,ACG17,ACG19
+2 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
1213 IF ACG13=""!(ACG19="")!(ACG13'="A1")!(ACG19<59)!(ACG19>60)
GOTO 1217
+1 IF ACG13="A1"
IF ACG19="60"
IF Y="B"
QUIT
+2 IF ACG13="A1"
IF ACG19="59"
IF Y="A"
QUIT
1217 IF ACG17=""
GOTO 1219
+1 IF "BOTU"'[$EXTRACT(ACG1)
IF "ABCDEFGHIJ"[$EXTRACT(ACG17,2)
IF Y="A"
QUIT
+2 IF "BOTU"'[$EXTRACT(ACG1)
IF ACG17="4K"
IF Y'="A"
1219 IF ACG19=""
QUIT
+1 IF ACG19<60
IF Y="A"
QUIT
+2 IF ACG19>59
IF Y'="A"
+3 GOTO EXIT
SP12 IF "^15^17^"'[(U_+^ACGS(DA,"DT")_U)
QUIT
SET ACG306=$PIECE(^("SP"),U,6)
+1 IF ACG306=1!(ACG306=5)
QUIT
+2 IF ACG306>1
IF ACG306<5
IF Y="A"
+3 GOTO EXIT
13 NEW ACGI,ACG12,ACG19
+1 FOR ACGI=12,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 SET ACG13=$PIECE(^AUTTTOB(+Y,0),U)
+3 IF ACG19=""
QUIT
+4 IF 5960[ACG19
IF ACG13="A1"
QUIT
+5 IF "50525355"[ACG19
IF "A2A3C5"[ACG13
QUIT
+6 IF "505253555960"'[ACG19
+7 GOTO EXIT
16 NEW ACGI
+1 FOR ACGI=271
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 IF ACG271=""
QUIT
+3 IF ACG271=1
IF Y=1
QUIT
+4 IF ACG271=2
IF Y=2
+5 GOTO EXIT
17 NEW ACGI,ACG12,ACG18,ACG19,ACG27
+1 FOR ACGI=12,18,19,27
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 SET ACG17=$PIECE(^ACGSP(Y,0),U)
1712 IF ACG12=""
GOTO 1719
+1 IF ACG12'="A"
IF ACG17="4K"
QUIT
+2 IF ACG12="A"
IF ACG17'="4K"
1719 IF ACG19<59!(ACG19>60)
QUIT
+1 IF ACG19=59
IF ACG17="4J"
QUIT
+2 IF ACG19=60
IF ACG17="4K"
QUIT
+3 GOTO EXIT
18 NEW ACGI,ACG17,ACG19
+1 FOR ACGI=1,17,19,62
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 SET ACG18=$PIECE(^ACGFAO(Y,0),U)
+3 IF ACG62="C"
IF ACG18=81
QUIT
+4 IF ACG17="4K"
IF ACG19=60
IF ACG18=81
QUIT
+5 IF ACG17="4K"
IF ACG18>69
QUIT
+6 IF ACG17'="4K"
+7 GOTO EXIT
19 NEW ACGI,ACG12
+1 FOR ACGI=1,12,13,17
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 SET ACG19=$PIECE(^ACGEOC(Y,0),U)
+3 IF ACG12=""&(ACG13="")
QUIT
+4 IF ACG12]""
Begin DoDot:1
+5 IF "BCD"[ACG12
IF ACG19>59
QUIT
+6 IF ACG12="A"
IF ACG17'="4J"
IF ACG19<60
QUIT
+7 IF ACG12="A"
IF ACG17="4J"
IF ACG19<60
IF (ACG19>49&(ACG19<56))!(ACG19>57)
QUIT
End DoDot:1
IF '$TEST
QUIT
+8 IF ACG13]""
Begin DoDot:1
+9 IF ACG13="A1"
IF ACG19=59!(ACG19=60)
QUIT
+10 IF "A2A3C5"[ACG13
IF 50525355[ACG19
QUIT
+11 IF "A1A2A3C5"'[ACG13
IF 505253555960'[ACG19
QUIT
End DoDot:1
+12 GOTO EXIT
20 NEW ACGI,ACG13,ACG17
+1 FOR ACGI=1,12,13,17
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 SET ACG20=$PIECE(^ACGMOC(Y,0),U)
2012 IF ACG12=""
GOTO 2017
+1 IF ACG12="A"
IF ACG20<4
GOTO 2017
+2 IF ACG12'="A"
IF ACG20<4
GOTO EXIT
2017 IF ACG17=""
GOTO 2019
+1 IF ACG17="4A"
IF ACG20<3
GOTO EXIT
+2 IF ACG17="4K"
IF ACG20=4
GOTO EXIT
+3 IF ACG17'="4K"
IF ACG20<4
+4 GOTO EXIT
2019 QUIT
21 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
26 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
27 NEW ACGI
+1 FOR ACGI=1,13,16,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 IF ACG16=""
GOTO EXIT
+3 ;I ACG16=$P(^ACGPPC(+Y,0),U,4)
+4 GOTO EXIT
30 NEW ACGI
+1 FOR ACGI=1,13
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 IF "A1A2A3"'[ACG13
IF Y=1
IF 0
GOTO EXIT
+3 IF "A1A2A3"[ACG13
IF Y=1!(Y=2)
GOTO EXIT
+4 IF "A1A2A3"'[ACG13
IF Y=2
GOTO EXIT
+5 GOTO EXIT
31 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
34 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
45 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
52 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
56 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
62 QUIT
NEW ACGI
+1 FOR ACGI=1,13,17,19
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+2 GOTO EXIT
63 QUIT
NEW ACGI
+1 DO ACG27
DO ACG53
+2 FOR ACGI=1,13,17,19,27,53
SET ACG="ACG"_ACGI
DO @ACG^ACGSIE1
+3 IF "A1A2A3B1B2"'[ACG13
QUIT
+4 IF '$DATA(ACG27(ACG27))&'$DATA(ACG53(ACG53))
QUIT
+5 IF Y=1
QUIT
+6 GOTO EXIT
66 NEW ACGI
+1 DO ACG13^ACGSIE1
+2 IF "^A1^A2^A3^"[(U_ACG13_U)
QUIT
+3 IF "^A1^A2^A3^"'[(U_ACG13_U)
IF X=""
QUIT
+4 GOTO EXIT
67 NEW ACGI
+1 DO ACG13^ACGSIE1
+2 IF ACG13="C5"
QUIT
+3 IF '$TEST
KILL X
+4 GOTO EXIT
68 NEW ACGI
+1 DO ACG13^ACGSIE1
+2 IF ACG13="C5"
QUIT
+3 IF '$TEST
KILL X
+4 GOTO EXIT
69 NEW ACGI
+1 DO ACG13^ACGSIE1
+2 IF ACG13="C5"
QUIT
+3 IF '$TEST
KILL X
+4 GOTO EXIT
SP17 DO ACGSP17
+1 IF ACGSP17="A1"
QUIT
IF Y=2!(Y=4)!(Y=5)
+2 GOTO EXIT
ACGSP17 SET ACGSP17=$PIECE(^ACGS(DA,"SP"),U,XX)
+1 QUIT
ACG53 FOR X=1521,1522,1531,1541,1542,1611,1622,1623,1629,1711,1721,1731,1741,1742,1743,1751,1752,1761,1771,1781,1791,1793,1794,1795,1796,1799
SET ACG53(X)=""
+1 QUIT
ACG27 FOR X=11:1:19,21:1:24,29,30
SET ACG27("C1"_X)=""
+1 FOR X=11,13:1:16,19
SET ACG27("C2"_X)=""
+2 FOR X="G004","J099","J999","K099","Q201","R404","R406","R497","S205"
SET ACG27(X)=""
+3 FOR X=2,4,6,8,9
SET ACG27("T00"_X)=""
+4 FOR X="T014",6505,7045,7110,7510
SET ACG27(X)=""
+5 QUIT
