- ACGTEMP ;IHS/OIRM/DSD/THL,AEF- NEW PROGRAM [ 03/16/2000 2:25 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- Q
- DIR ;
- S DIR=74000-91000+1030032+163359-274267-1519+7325762+149507+647559+100000-203218+314065+93151+84887+7697753+124729-123711+662289+1812018+15000-206630+92338-64325+14585+8054163+1471+98000+1514647+437566-72444+803610+217125+5945+74328+356034-86897+11897289
- S INDIR=905842+16562+63000+113105+9463+1016221+231440+139638+1389756-137893+1045617+1617325+105125
- W !,DIR,!,INDIR
- Q
- 23 S X=24100000,U="^"
- F S X=$O(^ACGS(X)) Q:$E(X,1,3)'=241 S ACGDT1=^(X,"DT1"),ACG=^(10),ACGDT2=^("DT2"),ACG23=$P(ACGDT1,U,2) I ACG23=9999999 D
- .W !,X,?10
- .S ACG37=$P(ACG,U,4),Z=$P(^AUTTCAN(ACG37,0),U),ACG37=$P(ACGDT2,U,2),ACG38=$P(ACGDT2,U,3),$P(^ACGS(X,"DT1"),U,2)=$P(^ACGS(X,"DT1"),U,3)
- .W $P(^("DT1"),U,2)
- .I ACG37="",Z'="",ACG38 S $P(^ACGS(X,"DT2"),U,2)=Z W ?20,$P(^("DT2"),U,2)
- Q
- LENG S ACGRDA=0
- F S ACGRDA=$O(^UTILITY("ACGERR",ACGRDA)) Q:'ACGRDA D ^ACGSFLX
- Q
- NSA S X=28500000 F S X=$O(^ACGS(X)) Q:'X S ACG28=$P(^(X,"DT1"),U,7),ACG282=$E(ACG28,3,7) I ACG282="00875"!(ACG282="00355")!(ACG282="00850") D
- .W !,X,?10,ACG28
- .S ACG28=$P(ACG28,ACG282)_$S(ACG282="00875":12160,ACG282="00355":14310,1:12188)_$P(ACG28,ACG282,2)
- .S $P(^ACGS(X,"DT1"),U,7)=ACG28
- .W ?40,$P(^("DT1"),U,7)
- Q
- GL S X=24200000 F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT"),ACGDT1=^("DT1") D
- .I $P(ACGDT1,U,7)["TOHA" W !,X,?10,$P(ACGDT1,U,7),?20,$P(ACGDT,U,7),?40,$P(ACGDT,U,10) Q
- .I $P(ACGDT1,U,7)["WINDOW ROCK" W !,X,?10,$P(ACGDT1,U,7),?20,$P(ACGDT,U,7),?40,$P(ACGDT,U,10) Q
- .I $P(ACGDT1,U,7)["SALLI" W !,X,?10,$P(ACGDT1,U,7),?20,$P(ACGDT,U,7),?40,$P(ACGDT,U,10) Q
- .I $P(ACGDT1,U,7)["LAWREN" W !,X,?10,$P(ACGDT1,U,7),?20,$P(ACGDT,U,7),?40,$P(ACGDT,U,10) Q
- Q
- ABERDEEN F X=1688:1:1691,1693:1:1695,1698:1:1700,1705,1707:1:1709,1711,1722:1:1725,1761,1790:1:1792,1796:1:1799,1819,1827,1832,1838,1839,1943:1:1945,1965,1978:1:1980 S Y="2410"_X W !!,Y,?20,$P(^ACGS(Y,"DT1"),U,2) R ZZ
- Q
- 45 S X=0,U="^"
- ;F S X=$O(^ACGS(X)) Q:X>23501096 I $P(^(X,"DT2"),U,3)<25000,$P(^("DT2"),U,10) W !,X S $P(^("DT2"),U,10)=$S($P(^("DT"),U,18)'=77:3,1:1)
- F S X=$O(^ACGS(X)) Q:X>23501096 I $P(^(X,"DT2"),U,3)<25000,$P(^("DT2"),U,10)<3 W !,X S $P(^("DT2"),U,10)=3
- Q
- 37 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACG37=$P(^ACGS(X,"DT2"),U,2) D
- .I ACG37["-" S ACG37=$P(ACG37,"-",2) S $P(^("DT2"),U,2)=ACG37 W !,X,?10,ACG37 Q
- .I $L(ACG37)>7,$E(ACG37) S ACG37=$E(ACG37,2,8) S:"j"=$E(ACG37) ACG37="J"_$E(ACG37,2,8) S $P(^("DT2"),U,2)=ACG37 W !,X,?10,ACG37
- Q
- 20 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT") I $P(ACGDT,U,17)=12,$P(ACGDT,U,19)>59,$P(ACGDT,U,20)<4 S $P(^("DT"),U,20)=4 W !,X
- Q
- X20 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT") I $P(ACGDT,U,17)=1,$P(ACGDT,U,20)>2 S $P(^("DT"),U,20)=2 W !,X
- Q
- 64 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT"),ACGDT3=^("DT3") D
- .I $P(ACGDT3,U,9)=1,$P(ACGDT3,U,10)="" S $P(^("DT3"),U,10)=2 W !,X
- .I $P(ACGDT,U,12)'="A",$P(ACGDT,U,17)=12,$P(ACGDT,U,18)="" S $P(^("DT"),U,18)=81 W !?10,X
- Q
- 18 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT") I $P(ACGDT,U,12)'="A",$P(ACGDT,U,17)=12,$P(ACGDT,U,18)="" S $P(^("DT"),U,18)=81 W !,X
- Q
- 1800 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT") I $P(ACGDT,U,12)="A",$P(ACGDT,U,17)<12,$P(ACGDT,U,19)<60,$P(ACGDT,U,18)'="" S $P(^("DT"),U,18)="" W !,X
- Q
- 16130 S X=16100000,U="^"
- F S X=$O(^ACGS(X)) Q:$E(X,1,3)'=161 I $P(^(X,"DT1"),U,9)=1,$P(^ACGS($P(^(0),U,3),"DT1"),U,9)'=1 S $P(^ACGS(X,"DT1"),U,9)=2 W !,X
- Q
- 1860 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT") I "CD"[$P(ACGDT,U,12),$P(ACGDT,U,19)=60 S $P(^("DT"),U,12)="B" W !,X
- Q
- 12 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X I $D(^ACGS(X,"DT")) S ACGDT=^("DT") I $P(ACGDT,U,12)="A",$P(ACGDT,U,17)=12,$P(ACGDT,U,19)>59 S $P(^("DT"),U,12)="B" S:$P(ACGDT,U,18)="" $P(^("DT"),U,18)=81 W !,X
- Q
- 1718 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X S ACGDT=^(X,"DT") I $P(ACGDT,U,12)'="A",$P(ACGDT,U,17)="" S $P(^("DT"),U,17)=12,$P(ACGDT,U,18)=81,$P(^("DT3"),U,7)="C" W !,X
- Q
- 1271 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X I $D(^ACGS(X,"DT")) S ACGDT=^("DT") I $P(ACGDT,U,12)="C" S:$P(ACGDT,U,17)'=12 $P(^("DT"),U,12)=12 S:$P(ACGDT,U,18)'=71 $P(^("DT"),U,18)=71 W !,X
- Q
- 8 S X=0,U="^"
- F S X=$O(^ACGS(X)) Q:'X I $D(^(X,"DT")) S ACGDT=^("DT"),ACG8=$P(ACGDT,U,8) D:'ACG8
- .W !,X,?15,ACG8
- Q
- 30 S X=16100000,U="^"
- F S X=$O(^ACGS(X)) Q:'X!($E(X,1,3)'=161) I $D(^(X,"DT1")) S ACGDT1=^("DT1"),ACG30=$P(ACGDT1,U,9) D
- .I ACG30="" S $P(^("DT1"),U,9)=2 W !,X
- .I ACG30["N" S $P(^("DT1"),U,9)=2 W !,X
- .I ACG30["Y" S $P(^("DT1"),U,9)=1 W !,X
- Q
- 28 S X=0,U="^"
- F S X=$O(^ACGS("C",X)) Q:'X S ACG28=$P(^ACGS(X,"DT1"),U,7) I $E(ACG28,1,7)?7N S Y=0 F S Y=$O(^ACGS("C",X,Y)) Q:'Y I X'=Y S ACG282=$P(^ACGS(Y,"DT1"),U,7) I $E(ACG282,1,7)'?7N S $P(^("DT1"),U,7)=ACG28
- Q
- XX28 Q:$E(X,1,3)'=161 S ACG28=$P(^(X,"DT1"),U,7) D
- .I ACG28="AUSTIN" S $P(^("DT1"),U,7)="4805000"_ACG28 W !,X
- .I ACG28["FT DEFI" S $P(^("DT1"),U,7)="0424460"_ACG28 W !,X
- .I ACG28["EL HUER" S $P(^("DT1"),U,7)="3522930"_ACG28 W !,X
- .I ACG28="0475660" S $P(^("DT1"),U,7)="0475660"_"TSAILE" W !,X
- Q
- 19 S X=16100000,U="^"
- F S X=$O(^ACGS(X)) Q:$E(X,1,3)'=161 I $P(^(X,"DT"),U,19),$P(^("DT"),U,19)<50 S $P(^("DT"),U,19)=$P(^("DT"),U,19)+49 W !,X
- Q
- 13 S X="INTER-TRIBAL COUNCIL OF NEVADA",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=14 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="PHX SERVICE UNIT INDIAN HEALTH",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=14 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="DONALD PANCOAST, DDS",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=5 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="SPECTRONIX",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=5 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="SPECIALTY CONTRACTORS",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=3 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="E.I. DUPONT DENEMOURS & CO.",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=5 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="HATCH CONCRETE",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=3 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="E&E LINEN SERVICE",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=3 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="KYASHNYAM INDIAN PATROLS, INC.",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=2 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- S X="DICENSO MD,SABATINO",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y I $P(^ACGS(Y,"DT"),U,13)="" S $P(^("DT"),U,13)=3 W !,$P(^("DT"),U,5),?40,$P(^AUTTTOB($P(^ACGS(Y,"DT"),U,13),0),U)
- Q
- MCD S X="FT MCDERMITT PAIUTE SHOSHONE",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y S ACG28=$P(^ACGS(Y,"DT1"),U,7),ACG281=+ACG28,ACG282=$P(ACG28,ACG281,2) I $E(ACG282,1,3)="MCD" S ACG28=ACG281_"FT "_ACG282,$P(^("DT1"),U,7)=ACG28 W !,Y,?15,$P(^("DT1"),U,7)
- Q
- SAN S X="SAN JOAQUIN COUNCIL FOR AMERIC",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y S ACG28=$P(^ACGS(Y,"DT1"),U,7) I $E(ACG28,8,10)="MCD" S ACG28="0675000"_"SAN JOAQUIN COUNTY",$P(^("DT1"),U,7)=ACG28 W !,Y,?15,$P(^("DT1"),U,7)
- Q
- TOH S X="LOUIS L. WELLER,ARCHITECTS,P.C",Y=0
- F S Y=$O(^ACGS("O",X,Y)) Q:'Y S ACG28=$P(^ACGS(Y,"DT1"),U,7) I $E(ACG28,1,3)="TOH" S ACG28="3578440"_ACG28,$P(^("DT1"),U,7)=ACG28 W !,Y,?15,$P(^("DT1"),U,7)
- Q
- CONG S XX=24602
- F X=1:1:6,99 S Y=$S(X'=99:"00"_X,1:"099") D
- .I Y="001" F Z=285 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- .I Y="002" F Z=273,275,282,290,291,300,307,314,315,318:1:321,324,326:1:329,358,369,441,464:1:466,479 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- .I Y="003" F Z=271,281,289,293,295,297,311,312,316,322,331,373,443,457,458,459 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- .I Y="004" F Z=152,284,292,299,463 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- .I Y="005" F Z=106,279,280,288,296,310,325 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- .I Y="006" F Z=274,276,277,286,298,313,323,330,332,467 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- .I Y="099" F Z=476,317 S ZZ=XX_Z,$P(^ACGS(ZZ,"DT"),U,10)=Y W !,$P(^("DT"),U,10)
- Q
- 51 S X=0,U="^" F S X=$O(^ACGS(X)) Q:'X I $P(^(X,"DT2"),U,16)'?1N S $P(^("DT2"),U,16)=$S($P(^("DT2"),U,16)["N":2,1:1) W !,X,?10,$P(^("DT2"),U,16)
- Q
- 62 S X=0,U="^" F S X=$O(^ACGS(X)) Q:'X I $P(^(X,"DT3"),U,7)="" S $P(^("DT3"),U,7)="A" W !,X,?10,$P(^("DT3"),U,7)
- Q
- 66 S X=0,U="^" F S X=$O(^ACGS(X)) Q:'X I $P(^(X,"DT3"),U,11)'="",$P(^("DT"),U,13)>3 S $P(^("DT3"),U,11)="" W !,X,?10,$P(^("DT3"),U,11),?15,$P(^("DT"),U,13)
- Q
- ACGTEMP ;IHS/OIRM/DSD/THL,AEF- NEW PROGRAM [ 03/16/2000 2:25 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 QUIT
- DIR ;
- +1 SET DIR=74000-91000+1030032+163359-274267-1519+7325762+149507+647559+100000-203218+314065+93151+84887+7697753+124729-123711+662289+1812018+15000-206630+92338-64325+14585+8054163+1471+98000+1514647+437566-72444+803610+217125+5945+74328+356034-86
- 897+11897289
- +2 SET INDIR=905842+16562+63000+113105+9463+1016221+231440+139638+1389756-137893+1045617+1617325+105125
- +3 WRITE !,DIR,!,INDIR
- +4 QUIT
- 23 SET X=24100000
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF $EXTRACT(X,1,3)'=241
- QUIT
- SET ACGDT1=^(X,"DT1")
- SET ACG=^(10)
- SET ACGDT2=^("DT2")
- SET ACG23=$PIECE(ACGDT1,U,2)
- IF ACG23=9999999
- Begin DoDot:1
- +2 WRITE !,X,?10
- +3 SET ACG37=$PIECE(ACG,U,4)
- SET Z=$PIECE(^AUTTCAN(ACG37,0),U)
- SET ACG37=$PIECE(ACGDT2,U,2)
- SET ACG38=$PIECE(ACGDT2,U,3)
- SET $PIECE(^ACGS(X,"DT1"),U,2)=$PIECE(^ACGS(X,"DT1"),U,3)
- +4 WRITE $PIECE(^("DT1"),U,2)
- +5 IF ACG37=""
- IF Z'=""
- IF ACG38
- SET $PIECE(^ACGS(X,"DT2"),U,2)=Z
- WRITE ?20,$PIECE(^("DT2"),U,2)
- End DoDot:1
- +6 QUIT
- LENG SET ACGRDA=0
- +1 FOR
- SET ACGRDA=$ORDER(^UTILITY("ACGERR",ACGRDA))
- IF 'ACGRDA
- QUIT
- DO ^ACGSFLX
- +2 QUIT
- NSA SET X=28500000
- FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACG28=$PIECE(^(X,"DT1"),U,7)
- SET ACG282=$EXTRACT(ACG28,3,7)
- IF ACG282="00875"!(ACG282="00355")!(ACG282="00850")
- Begin DoDot:1
- +1 WRITE !,X,?10,ACG28
- +2 SET ACG28=$PIECE(ACG28,ACG282)_$SELECT(ACG282="00875":12160,ACG282="00355":14310,1:12188)_$PIECE(ACG28,ACG282,2)
- +3 SET $PIECE(^ACGS(X,"DT1"),U,7)=ACG28
- +4 WRITE ?40,$PIECE(^("DT1"),U,7)
- End DoDot:1
- +5 QUIT
- GL SET X=24200000
- FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- SET ACGDT1=^("DT1")
- Begin DoDot:1
- +1 IF $PIECE(ACGDT1,U,7)["TOHA"
- WRITE !,X,?10,$PIECE(ACGDT1,U,7),?20,$PIECE(ACGDT,U,7),?40,$PIECE(ACGDT,U,10)
- QUIT
- +2 IF $PIECE(ACGDT1,U,7)["WINDOW ROCK"
- WRITE !,X,?10,$PIECE(ACGDT1,U,7),?20,$PIECE(ACGDT,U,7),?40,$PIECE(ACGDT,U,10)
- QUIT
- +3 IF $PIECE(ACGDT1,U,7)["SALLI"
- WRITE !,X,?10,$PIECE(ACGDT1,U,7),?20,$PIECE(ACGDT,U,7),?40,$PIECE(ACGDT,U,10)
- QUIT
- +4 IF $PIECE(ACGDT1,U,7)["LAWREN"
- WRITE !,X,?10,$PIECE(ACGDT1,U,7),?20,$PIECE(ACGDT,U,7),?40,$PIECE(ACGDT,U,10)
- QUIT
- End DoDot:1
- +5 QUIT
- ABERDEEN FOR X=1688:1:1691,1693:1:1695,1698:1:1700,1705,1707:1:1709,1711,1722:1:1725,1761,1790:1:1792,1796:1:1799,1819,1827,1832,1838,1839,1943:1:1945,1965,1978:1:1980
- SET Y="2410"_X
- WRITE !!,Y,?20,$PIECE(^ACGS(Y,"DT1"),U,2)
- READ ZZ
- +1 QUIT
- 45 SET X=0
- SET U="^"
- +1 ;F S X=$O(^ACGS(X)) Q:X>23501096 I $P(^(X,"DT2"),U,3)<25000,$P(^("DT2"),U,10) W !,X S $P(^("DT2"),U,10)=$S($P(^("DT"),U,18)'=77:3,1:1)
- +2 FOR
- SET X=$ORDER(^ACGS(X))
- IF X>23501096
- QUIT
- IF $PIECE(^(X,"DT2"),U,3)<25000
- IF $PIECE(^("DT2"),U,10)<3
- WRITE !,X
- SET $PIECE(^("DT2"),U,10)=3
- +3 QUIT
- 37 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACG37=$PIECE(^ACGS(X,"DT2"),U,2)
- Begin DoDot:1
- +2 IF ACG37["-"
- SET ACG37=$PIECE(ACG37,"-",2)
- SET $PIECE(^("DT2"),U,2)=ACG37
- WRITE !,X,?10,ACG37
- QUIT
- +3 IF $LENGTH(ACG37)>7
- IF $EXTRACT(ACG37)
- SET ACG37=$EXTRACT(ACG37,2,8)
- IF "j"=$EXTRACT(ACG37)
- SET ACG37="J"_$EXTRACT(ACG37,2,8)
- SET $PIECE(^("DT2"),U,2)=ACG37
- WRITE !,X,?10,ACG37
- End DoDot:1
- +4 QUIT
- 20 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- IF $PIECE(ACGDT,U,17)=12
- IF $PIECE(ACGDT,U,19)>59
- IF $PIECE(ACGDT,U,20)<4
- SET $PIECE(^("DT"),U,20)=4
- WRITE !,X
- +2 QUIT
- X20 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- IF $PIECE(ACGDT,U,17)=1
- IF $PIECE(ACGDT,U,20)>2
- SET $PIECE(^("DT"),U,20)=2
- WRITE !,X
- +2 QUIT
- 64 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- SET ACGDT3=^("DT3")
- Begin DoDot:1
- +2 IF $PIECE(ACGDT3,U,9)=1
- IF $PIECE(ACGDT3,U,10)=""
- SET $PIECE(^("DT3"),U,10)=2
- WRITE !,X
- +3 IF $PIECE(ACGDT,U,12)'="A"
- IF $PIECE(ACGDT,U,17)=12
- IF $PIECE(ACGDT,U,18)=""
- SET $PIECE(^("DT"),U,18)=81
- WRITE !?10,X
- End DoDot:1
- +4 QUIT
- 18 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- IF $PIECE(ACGDT,U,12)'="A"
- IF $PIECE(ACGDT,U,17)=12
- IF $PIECE(ACGDT,U,18)=""
- SET $PIECE(^("DT"),U,18)=81
- WRITE !,X
- +2 QUIT
- 1800 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- IF $PIECE(ACGDT,U,12)="A"
- IF $PIECE(ACGDT,U,17)<12
- IF $PIECE(ACGDT,U,19)<60
- IF $PIECE(ACGDT,U,18)'=""
- SET $PIECE(^("DT"),U,18)=""
- WRITE !,X
- +2 QUIT
- 16130 SET X=16100000
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF $EXTRACT(X,1,3)'=161
- QUIT
- IF $PIECE(^(X,"DT1"),U,9)=1
- IF $PIECE(^ACGS($PIECE(^(0),U,3),"DT1"),U,9)'=1
- SET $PIECE(^ACGS(X,"DT1"),U,9)=2
- WRITE !,X
- +2 QUIT
- 1860 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- IF "CD"[$PIECE(ACGDT,U,12)
- IF $PIECE(ACGDT,U,19)=60
- SET $PIECE(^("DT"),U,12)="B"
- WRITE !,X
- +2 QUIT
- 12 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- IF $DATA(^ACGS(X,"DT"))
- SET ACGDT=^("DT")
- IF $PIECE(ACGDT,U,12)="A"
- IF $PIECE(ACGDT,U,17)=12
- IF $PIECE(ACGDT,U,19)>59
- SET $PIECE(^("DT"),U,12)="B"
- IF $PIECE(ACGDT,U,18)=""
- SET $PIECE(^("DT"),U,18)=81
- WRITE !,X
- +2 QUIT
- 1718 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- SET ACGDT=^(X,"DT")
- IF $PIECE(ACGDT,U,12)'="A"
- IF $PIECE(ACGDT,U,17)=""
- SET $PIECE(^("DT"),U,17)=12
- SET $PIECE(ACGDT,U,18)=81
- SET $PIECE(^("DT3"),U,7)="C"
- WRITE !,X
- +2 QUIT
- 1271 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- IF $DATA(^ACGS(X,"DT"))
- SET ACGDT=^("DT")
- IF $PIECE(ACGDT,U,12)="C"
- IF $PIECE(ACGDT,U,17)'=12
- SET $PIECE(^("DT"),U,12)=12
- IF $PIECE(ACGDT,U,18)'=71
- SET $PIECE(^("DT"),U,18)=71
- WRITE !,X
- +2 QUIT
- 8 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- IF $DATA(^(X,"DT"))
- SET ACGDT=^("DT")
- SET ACG8=$PIECE(ACGDT,U,8)
- IF 'ACG8
- Begin DoDot:1
- +2 WRITE !,X,?15,ACG8
- End DoDot:1
- +3 QUIT
- 30 SET X=16100000
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X!($EXTRACT(X,1,3)'=161)
- QUIT
- IF $DATA(^(X,"DT1"))
- SET ACGDT1=^("DT1")
- SET ACG30=$PIECE(ACGDT1,U,9)
- Begin DoDot:1
- +2 IF ACG30=""
- SET $PIECE(^("DT1"),U,9)=2
- WRITE !,X
- +3 IF ACG30["N"
- SET $PIECE(^("DT1"),U,9)=2
- WRITE !,X
- +4 IF ACG30["Y"
- SET $PIECE(^("DT1"),U,9)=1
- WRITE !,X
- End DoDot:1
- +5 QUIT
- 28 SET X=0
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS("C",X))
- IF 'X
- QUIT
- SET ACG28=$PIECE(^ACGS(X,"DT1"),U,7)
- IF $EXTRACT(ACG28,1,7)?7N
- SET Y=0
- FOR
- SET Y=$ORDER(^ACGS("C",X,Y))
- IF 'Y
- QUIT
- IF X'=Y
- SET ACG282=$PIECE(^ACGS(Y,"DT1"),U,7)
- IF $EXTRACT(ACG282,1,7)'?7N
- SET $PIECE(^("DT1"),U,7)=ACG28
- +2 QUIT
- XX28 IF $EXTRACT(X,1,3)'=161
- QUIT
- SET ACG28=$PIECE(^(X,"DT1"),U,7)
- Begin DoDot:1
- +1 IF ACG28="AUSTIN"
- SET $PIECE(^("DT1"),U,7)="4805000"_ACG28
- WRITE !,X
- +2 IF ACG28["FT DEFI"
- SET $PIECE(^("DT1"),U,7)="0424460"_ACG28
- WRITE !,X
- +3 IF ACG28["EL HUER"
- SET $PIECE(^("DT1"),U,7)="3522930"_ACG28
- WRITE !,X
- +4 IF ACG28="0475660"
- SET $PIECE(^("DT1"),U,7)="0475660"_"TSAILE"
- WRITE !,X
- End DoDot:1
- +5 QUIT
- 19 SET X=16100000
- SET U="^"
- +1 FOR
- SET X=$ORDER(^ACGS(X))
- IF $EXTRACT(X,1,3)'=161
- QUIT
- IF $PIECE(^(X,"DT"),U,19)
- IF $PIECE(^("DT"),U,19)<50
- SET $PIECE(^("DT"),U,19)=$PIECE(^("DT"),U,19)+49
- WRITE !,X
- +2 QUIT
- 13 SET X="INTER-TRIBAL COUNCIL OF NEVADA"
- SET Y=0
- +1 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=14
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +2 SET X="PHX SERVICE UNIT INDIAN HEALTH"
- SET Y=0
- +3 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=14
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +4 SET X="DONALD PANCOAST, DDS"
- SET Y=0
- +5 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=5
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +6 SET X="SPECTRONIX"
- SET Y=0
- +7 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=5
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +8 SET X="SPECIALTY CONTRACTORS"
- SET Y=0
- +9 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=3
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +10 SET X="E.I. DUPONT DENEMOURS & CO."
- SET Y=0
- +11 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=5
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +12 SET X="HATCH CONCRETE"
- SET Y=0
- +13 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=3
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +14 SET X="E&E LINEN SERVICE"
- SET Y=0
- +15 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=3
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +16 SET X="KYASHNYAM INDIAN PATROLS, INC."
- SET Y=0
- +17 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=2
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +18 SET X="DICENSO MD,SABATINO"
- SET Y=0
- +19 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- IF $PIECE(^ACGS(Y,"DT"),U,13)=""
- SET $PIECE(^("DT"),U,13)=3
- WRITE !,$PIECE(^("DT"),U,5),?40,$PIECE(^AUTTTOB($PIECE(^ACGS(Y,"DT"),U,13),0),U)
- +20 QUIT
- MCD SET X="FT MCDERMITT PAIUTE SHOSHONE"
- SET Y=0
- +1 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- SET ACG28=$PIECE(^ACGS(Y,"DT1"),U,7)
- SET ACG281=+ACG28
- SET ACG282=$PIECE(ACG28,ACG281,2)
- IF $EXTRACT(ACG282,1,3)="MCD"
- SET ACG28=ACG281_"FT "_ACG282
- SET $PIECE(^("DT1"),U,7)=ACG28
- WRITE !,Y,?15,$PIECE(^("DT1"),U,7)
- +2 QUIT
- SAN SET X="SAN JOAQUIN COUNCIL FOR AMERIC"
- SET Y=0
- +1 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- SET ACG28=$PIECE(^ACGS(Y,"DT1"),U,7)
- IF $EXTRACT(ACG28,8,10)="MCD"
- SET ACG28="0675000"_"SAN JOAQUIN COUNTY"
- SET $PIECE(^("DT1"),U,7)=ACG28
- WRITE !,Y,?15,$PIECE(^("DT1"),U,7)
- +2 QUIT
- TOH SET X="LOUIS L. WELLER,ARCHITECTS,P.C"
- SET Y=0
- +1 FOR
- SET Y=$ORDER(^ACGS("O",X,Y))
- IF 'Y
- QUIT
- SET ACG28=$PIECE(^ACGS(Y,"DT1"),U,7)
- IF $EXTRACT(ACG28,1,3)="TOH"
- SET ACG28="3578440"_ACG28
- SET $PIECE(^("DT1"),U,7)=ACG28
- WRITE !,Y,?15,$PIECE(^("DT1"),U,7)
- +2 QUIT
- CONG SET XX=24602
- +1 FOR X=1:1:6,99
- SET Y=$SELECT(X'=99:"00"_X,1:"099")
- Begin DoDot:1
- +2 IF Y="001"
- FOR Z=285
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- +3 IF Y="002"
- FOR Z=273,275,282,290,291,300,307,314,315,318:1:321,324,326:1:329,358,369,441,464:1:466,479
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- +4 IF Y="003"
- FOR Z=271,281,289,293,295,297,311,312,316,322,331,373,443,457,458,459
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- +5 IF Y="004"
- FOR Z=152,284,292,299,463
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- +6 IF Y="005"
- FOR Z=106,279,280,288,296,310,325
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- +7 IF Y="006"
- FOR Z=274,276,277,286,298,313,323,330,332,467
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- +8 IF Y="099"
- FOR Z=476,317
- SET ZZ=XX_Z
- SET $PIECE(^ACGS(ZZ,"DT"),U,10)=Y
- WRITE !,$PIECE(^("DT"),U,10)
- End DoDot:1
- +9 QUIT
- 51 SET X=0
- SET U="^"
- FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- IF $PIECE(^(X,"DT2"),U,16)'?1N
- SET $PIECE(^("DT2"),U,16)=$SELECT($PIECE(^("DT2"),U,16)["N":2,1:1)
- WRITE !,X,?10,$PIECE(^("DT2"),U,16)
- +1 QUIT
- 62 SET X=0
- SET U="^"
- FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- IF $PIECE(^(X,"DT3"),U,7)=""
- SET $PIECE(^("DT3"),U,7)="A"
- WRITE !,X,?10,$PIECE(^("DT3"),U,7)
- +1 QUIT
- 66 SET X=0
- SET U="^"
- FOR
- SET X=$ORDER(^ACGS(X))
- IF 'X
- QUIT
- IF $PIECE(^(X,"DT3"),U,11)'=""
- IF $PIECE(^("DT"),U,13)>3
- SET $PIECE(^("DT3"),U,11)=""
- WRITE !,X,?10,$PIECE(^("DT3"),U,11),?15,$PIECE(^("DT"),U,13)
- +1 QUIT