ACGSRQF1 ;IHS/OIRM/DSD/THL,AEF - CONTROL CIS FIELDS AND EXPORT VARIABLES ; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;CONTROL CIS FIELDS AND EXPORT VARIABLES
EN I $D(^ACGS(ACGRDA,"DT"))&$D(^("DT1"))&$D(^("DT2"))&$D(^("DT3")) S ACGDT=^("DT"),ACGDT1=^("DT1"),ACGDT2=^("DT2"),ACGDT3=^("DT3"),ACGIHS=^("IHS"),ACGSP=$G(^("SP")) D 1
EXIT K ACGSIGN,ACGX
Q
1 S X=$P(ACGDT,U),ACG1=$S(X="":"",$D(^ACGTPA(X,0)):$E($P(^(0),U)),1:"")
2 S ACG2=$E($P(ACGDT,U,2),1,15)
3 S ACG3=$E($P(ACGDT,U,3),1,12)
4 S ACG4=$E($P(ACGDT,U,4),1,3)
5 S ACG5=$E($P(ACGDT,U,5),1,40)
6 S ACG6=$E($P(ACGDT,U,6),1,30)
7 S ACG7=$E($P(ACGDT,U,7),1,23)
8 S X=$P(ACGDT,U,8),X=$S(X="":"",$D(^DIC(5,X,0)):$P(^(0),U),1:$O(^DIC(5,"B",X,0))),ACG8=$E(X,1,19)
9 S ACG9=$E($P(ACGDT,U,9),1,5)
10 S ACG10=$E($P(ACGDT,U,10),1,3)
11 S ACG11=$E($P(ACGDT,U,11),1,12)
12 S ACG12=$E($P(ACGDT,U,12))
13 S X=$P(ACGDT,U,13),ACG13=$S(X="":"",$D(^AUTTTOB(X,0)):$P(^(0),U),1:"")
14 S ACG14=$E($P(ACGDT,U,14),1,2)
15 S X=$P(ACGDT,U,15),ACG15=$S(X="":"",$D(^ACGTOC(X,0)):$P(^(0),U),1:"")
16 S ACG16=$E($P(ACGDT,U,16))
17 S X=$P(ACGDT,U,17),ACG17=$S(X="":"",$D(^ACGSP(X,0)):$P(^(0),U),1:"")
18 S X=$P(ACGDT,U,18),ACG18=$S(X="":"",$D(^ACGFAO(X,0)):$P(^(0),U),1:"")
19 S X=$P(ACGDT,U,19),ACG19=$S(X="":"",$D(^ACGEOC(X,0)):$P(^(0),U),1:"")
20 S X=$P(ACGDT,U,20),ACG20=$S(X="":"",$D(^ACGMOC(X,0)):$P(^(0),U),1:"")
21 S ACG21=$E($P(ACGDT,U,21),1,2)
22 S ACG22=$E($P(ACGDT1,U),1,97)
23 S ACG23=$E($P(ACGDT1,U,2),2,7)
24 S ACG24=$E($P(ACGDT1,U,3),2,7)
25 S ACG25=$E($P(ACGDT1,U,4),2,7)
26 S ACG26=$P(ACGDT1,U,5)
27 S X=$P(ACGDT1,U,6),ACG27=$S('X:"",$D(^ACGPPC(X,0)):$P(^(0),U),1:"")
28 S ACG28=$E($P(ACGDT1,U,7),1,25)
29 S ACG29=$E($P(ACGDT1,U,8))
30 S X=$P(ACGDT1,U,9),ACG30=$S(X:X,1:2)
31 S ACG31=$E($P(ACGDT1,U,10))
32 S ACG32=$E($P(ACGDT1,U,11))
33 S ACG33=$E($P(ACGDT1,U,12),1,8)
34 S ACG34=$E($P(ACGDT1,U,13),2,7)
35 S ACG35=$E($P(ACGDT1,U,14),1,20)
36 S ACG36=$E($P(ACGDT2,U),1,10)
37 S ACGFY=$E($P(ACGIHS,U,4),2),X=$E($P(ACGDT2,U,2),1,7),ACG37=$S($L(X)=7:ACGFY_X,1:"")
38 S ACG38=$P(ACGDT2,U,3)
39 S X=$E($P(ACGDT2,U,4),1,7),ACG39=$S($L(X)=7:ACGFY_X,1:"")
40 S ACG40=$P(ACGDT2,U,5)
41 S X=$E($P(ACGDT2,U,6),1,7),ACG41=$S($L(X)=7:ACGFY_X,1:"")
42 S ACG42=$P(ACGDT2,U,7)
43 S ACG43=$P(ACGDT2,U,8)
44 S ACG44=$P(ACGDT2,U,9)
45 S ACG45=$E($P(ACGDT2,U,10))
46 S ACG46=$P(ACGDT2,U,11)
47 S ACG47=$P(ACGDT2,U,12)
48 S ACG48=$P(ACGDT2,U,13)
49 S ACG49=$P(ACGDT2,U,14)
50 S ACG50=$P(ACGDT2,U,15)
51 S ACG51=$E($P(ACGDT2,U,16))
52 S X=$E($P(ACGDT2,U,17)),ACG52=$S("ABC"[$P(ACGDT3,U,7):"",X'="":X,1:"")
53 S ACG53=$E($P(ACGDT2,U,18),1,4)
54 S ACG54=$E($P(ACGDT2,U,19),1,30)
55 S ACG55=$E($P(ACGDT2,U,20),1,12)
56 S ACG56=$E($P(ACGDT3,U,1))
57 S ACG57=$E($P(ACGDT3,U,2))
58 S ACG58=$E($P(ACGDT3,U,3))
59 S ACG59=$P(ACGDT3,U,4)
60 S ACG60=$E($P(ACGDT3,U,5))
61 S ACG61=$E($P(ACGDT3,U,6),1,4)
62 S ACG62=$E($P(ACGDT3,U,7))
63 S ACG63=$E($P(ACGDT3,U,8))
64 S ACG64=$E($P(ACGDT3,U,9))
65 S ACG65=$E($P(ACGDT3,U,10))
66 S X=$P(ACGDT3,U,11),ACG66=$S(X="":"",$D(^AUTTSOB(X,0)):$P(^(0),U),1:"")
67 S ACG67=$E($P(ACGDT3,U,12),1,10)
68 S ACG68=$E($P(ACGDT3,U,13),1,10)
69 S ACG69=$E($P(ACGDT3,U,14),1,12)
70 S ACG70=""
301 S ACG301=$P(ACGSP,U)
302 S ACG302=$P(ACGSP,U,2)
303 S ACG303=$P(ACGSP,U,3)
304 S ACG304=$P(ACGSP,U,4)
305 S ACG305=$P(ACGSP,U,5)
306 S ACG306=$P(ACGSP,U,6)
ACGSRQF1 ;IHS/OIRM/DSD/THL,AEF - CONTROL CIS FIELDS AND EXPORT VARIABLES ; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;CONTROL CIS FIELDS AND EXPORT VARIABLES
EN IF $DATA(^ACGS(ACGRDA,"DT"))&$DATA(^("DT1"))&$DATA(^("DT2"))&$DATA(^("DT3"))
SET ACGDT=^("DT")
SET ACGDT1=^("DT1")
SET ACGDT2=^("DT2")
SET ACGDT3=^("DT3")
SET ACGIHS=^("IHS")
SET ACGSP=$GET(^("SP"))
DO 1
EXIT KILL ACGSIGN,ACGX
+1 QUIT
1 SET X=$PIECE(ACGDT,U)
SET ACG1=$SELECT(X="":"",$DATA(^ACGTPA(X,0)):$EXTRACT($PIECE(^(0),U)),1:"")
2 SET ACG2=$EXTRACT($PIECE(ACGDT,U,2),1,15)
3 SET ACG3=$EXTRACT($PIECE(ACGDT,U,3),1,12)
4 SET ACG4=$EXTRACT($PIECE(ACGDT,U,4),1,3)
5 SET ACG5=$EXTRACT($PIECE(ACGDT,U,5),1,40)
6 SET ACG6=$EXTRACT($PIECE(ACGDT,U,6),1,30)
7 SET ACG7=$EXTRACT($PIECE(ACGDT,U,7),1,23)
8 SET X=$PIECE(ACGDT,U,8)
SET X=$SELECT(X="":"",$DATA(^DIC(5,X,0)):$PIECE(^(0),U),1:$ORDER(^DIC(5,"B",X,0)))
SET ACG8=$EXTRACT(X,1,19)
9 SET ACG9=$EXTRACT($PIECE(ACGDT,U,9),1,5)
10 SET ACG10=$EXTRACT($PIECE(ACGDT,U,10),1,3)
11 SET ACG11=$EXTRACT($PIECE(ACGDT,U,11),1,12)
12 SET ACG12=$EXTRACT($PIECE(ACGDT,U,12))
13 SET X=$PIECE(ACGDT,U,13)
SET ACG13=$SELECT(X="":"",$DATA(^AUTTTOB(X,0)):$PIECE(^(0),U),1:"")
14 SET ACG14=$EXTRACT($PIECE(ACGDT,U,14),1,2)
15 SET X=$PIECE(ACGDT,U,15)
SET ACG15=$SELECT(X="":"",$DATA(^ACGTOC(X,0)):$PIECE(^(0),U),1:"")
16 SET ACG16=$EXTRACT($PIECE(ACGDT,U,16))
17 SET X=$PIECE(ACGDT,U,17)
SET ACG17=$SELECT(X="":"",$DATA(^ACGSP(X,0)):$PIECE(^(0),U),1:"")
18 SET X=$PIECE(ACGDT,U,18)
SET ACG18=$SELECT(X="":"",$DATA(^ACGFAO(X,0)):$PIECE(^(0),U),1:"")
19 SET X=$PIECE(ACGDT,U,19)
SET ACG19=$SELECT(X="":"",$DATA(^ACGEOC(X,0)):$PIECE(^(0),U),1:"")
20 SET X=$PIECE(ACGDT,U,20)
SET ACG20=$SELECT(X="":"",$DATA(^ACGMOC(X,0)):$PIECE(^(0),U),1:"")
21 SET ACG21=$EXTRACT($PIECE(ACGDT,U,21),1,2)
22 SET ACG22=$EXTRACT($PIECE(ACGDT1,U),1,97)
23 SET ACG23=$EXTRACT($PIECE(ACGDT1,U,2),2,7)
24 SET ACG24=$EXTRACT($PIECE(ACGDT1,U,3),2,7)
25 SET ACG25=$EXTRACT($PIECE(ACGDT1,U,4),2,7)
26 SET ACG26=$PIECE(ACGDT1,U,5)
27 SET X=$PIECE(ACGDT1,U,6)
SET ACG27=$SELECT('X:"",$DATA(^ACGPPC(X,0)):$PIECE(^(0),U),1:"")
28 SET ACG28=$EXTRACT($PIECE(ACGDT1,U,7),1,25)
29 SET ACG29=$EXTRACT($PIECE(ACGDT1,U,8))
30 SET X=$PIECE(ACGDT1,U,9)
SET ACG30=$SELECT(X:X,1:2)
31 SET ACG31=$EXTRACT($PIECE(ACGDT1,U,10))
32 SET ACG32=$EXTRACT($PIECE(ACGDT1,U,11))
33 SET ACG33=$EXTRACT($PIECE(ACGDT1,U,12),1,8)
34 SET ACG34=$EXTRACT($PIECE(ACGDT1,U,13),2,7)
35 SET ACG35=$EXTRACT($PIECE(ACGDT1,U,14),1,20)
36 SET ACG36=$EXTRACT($PIECE(ACGDT2,U),1,10)
37 SET ACGFY=$EXTRACT($PIECE(ACGIHS,U,4),2)
SET X=$EXTRACT($PIECE(ACGDT2,U,2),1,7)
SET ACG37=$SELECT($LENGTH(X)=7:ACGFY_X,1:"")
38 SET ACG38=$PIECE(ACGDT2,U,3)
39 SET X=$EXTRACT($PIECE(ACGDT2,U,4),1,7)
SET ACG39=$SELECT($LENGTH(X)=7:ACGFY_X,1:"")
40 SET ACG40=$PIECE(ACGDT2,U,5)
41 SET X=$EXTRACT($PIECE(ACGDT2,U,6),1,7)
SET ACG41=$SELECT($LENGTH(X)=7:ACGFY_X,1:"")
42 SET ACG42=$PIECE(ACGDT2,U,7)
43 SET ACG43=$PIECE(ACGDT2,U,8)
44 SET ACG44=$PIECE(ACGDT2,U,9)
45 SET ACG45=$EXTRACT($PIECE(ACGDT2,U,10))
46 SET ACG46=$PIECE(ACGDT2,U,11)
47 SET ACG47=$PIECE(ACGDT2,U,12)
48 SET ACG48=$PIECE(ACGDT2,U,13)
49 SET ACG49=$PIECE(ACGDT2,U,14)
50 SET ACG50=$PIECE(ACGDT2,U,15)
51 SET ACG51=$EXTRACT($PIECE(ACGDT2,U,16))
52 SET X=$EXTRACT($PIECE(ACGDT2,U,17))
SET ACG52=$SELECT("ABC"[$PIECE(ACGDT3,U,7):"",X'="":X,1:"")
53 SET ACG53=$EXTRACT($PIECE(ACGDT2,U,18),1,4)
54 SET ACG54=$EXTRACT($PIECE(ACGDT2,U,19),1,30)
55 SET ACG55=$EXTRACT($PIECE(ACGDT2,U,20),1,12)
56 SET ACG56=$EXTRACT($PIECE(ACGDT3,U,1))
57 SET ACG57=$EXTRACT($PIECE(ACGDT3,U,2))
58 SET ACG58=$EXTRACT($PIECE(ACGDT3,U,3))
59 SET ACG59=$PIECE(ACGDT3,U,4)
60 SET ACG60=$EXTRACT($PIECE(ACGDT3,U,5))
61 SET ACG61=$EXTRACT($PIECE(ACGDT3,U,6),1,4)
62 SET ACG62=$EXTRACT($PIECE(ACGDT3,U,7))
63 SET ACG63=$EXTRACT($PIECE(ACGDT3,U,8))
64 SET ACG64=$EXTRACT($PIECE(ACGDT3,U,9))
65 SET ACG65=$EXTRACT($PIECE(ACGDT3,U,10))
66 SET X=$PIECE(ACGDT3,U,11)
SET ACG66=$SELECT(X="":"",$DATA(^AUTTSOB(X,0)):$PIECE(^(0),U),1:"")
67 SET ACG67=$EXTRACT($PIECE(ACGDT3,U,12),1,10)
68 SET ACG68=$EXTRACT($PIECE(ACGDT3,U,13),1,10)
69 SET ACG69=$EXTRACT($PIECE(ACGDT3,U,14),1,12)
70 SET ACG70=""
301 SET ACG301=$PIECE(ACGSP,U)
302 SET ACG302=$PIECE(ACGSP,U,2)
303 SET ACG303=$PIECE(ACGSP,U,3)
304 SET ACG304=$PIECE(ACGSP,U,4)
305 SET ACG305=$PIECE(ACGSP,U,5)
306 SET ACG306=$PIECE(ACGSP,U,6)
