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
