- 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)
