- 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
