ACGSFLD1 ;IHS/OIRM/DSD/THL,AEF - CONTROL CIS FIELDS AND EXPORT VARIABLES CON'T; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;CONTROL CIS FIELDS AND EXPORT VARIABLES - CON'T
36 S X=$E($P(ACGDT2,U),1,10),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
K ACGX
37 S ACGFY=$E($P(ACGDT3,U,16),2)
I ACGFY="" S ACGFY=$P(ACGDT1,U,3),ACGFY=$S($E(ACGFY,4,5)>9:$E(ACGFY,3)+1,1:$E(ACGFY,3)) S:$L(ACGFY)=2 ACGFY=$E(ACGFY,2) S $P(ACGIHS,U,4)=9_ACGFY
S X=$E($P(ACGDT2,U,2),1,7),X=$S($L(X)=7:ACGFY_X,1:" ")
D Y
38 S X=$P(ACGDT2,U,3),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
K ACGX
39 S ACGFY=$E($P(ACGDT3,U,17),2)
I ACGFY="" S ACGFY=$P(ACGDT1,U,3),ACGFY=$S($E(ACGFY,4,5)>9:$E(ACGFY,3)+1,1:$E(ACGFY,3)) S:$L(ACGFY)=2 ACGFY=$E(ACGFY,2) S $P(ACGIHS,U,4)=9_ACGFY
S X=$E($P(ACGDT2,U,4),1,7),X=$S($L(X)=7:ACGFY_X,1:" ")
D Y
40 S X=$P(ACGDT2,U,5),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
41 S ACGFY=$E($P(ACGDT3,U,18),2)
I ACGFY="" S ACGFY=$P(ACGDT1,U,3),ACGFY=$S($E(ACGFY,4,5)>9:$E(ACGFY,3)+1,1:$E(ACGFY,3)) S:$L(ACGFY)=2 ACGFY=$E(ACGFY,2) S $P(ACGIHS,U,4)=9_ACGFY
S X=$E($P(ACGDT2,U,6),1,7),X=$S($L(X)=7:ACGFY_X,1:" ")
D Y
42 S X=$P(ACGDT2,U,7),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
43 S X=$P(ACGDT2,U,8),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
44 S X=$P(ACGDT2,U,9),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
45 S X=$E($P(ACGDT2,U,10)),X=$S(X]"":X,1:" ")
D Y
46 S X=$P(ACGDT2,U,11),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
47 S X=$P(ACGDT2,U,12),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
48 S X=$P(ACGDT2,U,13),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
49 S X=$P(ACGDT2,U,14),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
50 S X=$P(ACGDT2,U,15),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:11-$L(ACGSIGN)-$L(X) $P(ACGX,"0",11-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
51 S X=$E($P(ACGDT2,U,16)),X=$S(X]"":X,1:"2")
D Y
52 S X=$E($P(ACGDT2,U,17)),X=$S("ABC"[$P(ACGDT3,U,7):" ",X]"":X,1:" ")
D Y
53 S X=$E($P(ACGDT2,U,18),1,4),X=$S(X]"":X,1:" ")
D Y
54 S X=$E($P(ACGDT2,U,19),1,30)
S:$L(X)<30 X=X_$J(" ",30-$L(X))
D Y
55 S X=$E($P(ACGDT2,U,20),1,12)
S:X]"" X=$S($L(X)=9:X,$L(X)=12:$E(X,2,10),1:"")
S:X="" X=" "
D Y
56 S X=$E($P(ACGDT3,U,1)),X=$S(X]"":X,1:" ")
D Y
57 S X=$E($P(ACGDT3,U,2)),X=$S(X]"":X,1:" ")
D Y
58 S X=$E($P(ACGDT3,U,3)),X=$S(X]"":X,1:" ")
D Y
59 S X=$P(ACGDT3,U,4),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
60 S X=$E($P(ACGDT3,U,5)),X=$S(X]"":X,1:" ")
D Y
61 S X=$E($P(ACGDT3,U,6),1,4),X=$S(X]"":"MULT",1:" ")
D Y
62 S X=$E($P(ACGDT3,U,7)),X=$S(X]"":X,1:" ")
D Y
63 S X=$E($P(ACGDT3,U,8)),X=$S(X]"":X,1:" ")
D Y
64 S X=$E($P(ACGDT3,U,9)),X=$S(X]"":X,1:" ")
D Y
65 S X=$E($P(ACGDT3,U,10)),X=$S(X]"":X,1:" ")
D Y
66 S X=$P(ACGDT3,U,11),X=$S('X:" ",$D(^AUTTSOB(X,0)):$P(^(0),U),1:" ")
D Y
67 S X=$E($P(ACGDT3,U,12),1,10),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
K ACGX
68 S X=$E($P(ACGDT3,U,13),1,10),ACGSIGN=$S($E(X)="-":"-",1:""),ACGX=""
S:ACGSIGN="-" X=$P(X,"-",2)
S:10-$L(ACGSIGN)-$L(X) $P(ACGX,"0",10-$L(ACGSIGN)-$L(X))="" S X=ACGSIGN_ACGX_X
D Y
K ACGX
69 S X=$E($P(ACGDT3,U,14),1,12)
S:$L(X)<12 X=X_$J(" ",12-$L(X))
D Y
70 S X=" "
D Y
K ACGX
Q
Y S ACGY=ACGY_X
Q
ACGSFLD1 ;IHS/OIRM/DSD/THL,AEF - CONTROL CIS FIELDS AND EXPORT VARIABLES CON'T; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;CONTROL CIS FIELDS AND EXPORT VARIABLES - CON'T
36 SET X=$EXTRACT($PIECE(ACGDT2,U),1,10)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
+4 KILL ACGX
37 SET ACGFY=$EXTRACT($PIECE(ACGDT3,U,16),2)
+1 IF ACGFY=""
SET ACGFY=$PIECE(ACGDT1,U,3)
SET ACGFY=$SELECT($EXTRACT(ACGFY,4,5)>9:$EXTRACT(ACGFY,3)+1,1:$EXTRACT(ACGFY,3))
IF $LENGTH(ACGFY)=2
SET ACGFY=$EXTRACT(ACGFY,2)
SET $PIECE(ACGIHS,U,4)=9_ACGFY
+2 SET X=$EXTRACT($PIECE(ACGDT2,U,2),1,7)
SET X=$SELECT($LENGTH(X)=7:ACGFY_X,1:" ")
+3 DO Y
38 SET X=$PIECE(ACGDT2,U,3)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
+4 KILL ACGX
39 SET ACGFY=$EXTRACT($PIECE(ACGDT3,U,17),2)
+1 IF ACGFY=""
SET ACGFY=$PIECE(ACGDT1,U,3)
SET ACGFY=$SELECT($EXTRACT(ACGFY,4,5)>9:$EXTRACT(ACGFY,3)+1,1:$EXTRACT(ACGFY,3))
IF $LENGTH(ACGFY)=2
SET ACGFY=$EXTRACT(ACGFY,2)
SET $PIECE(ACGIHS,U,4)=9_ACGFY
+2 SET X=$EXTRACT($PIECE(ACGDT2,U,4),1,7)
SET X=$SELECT($LENGTH(X)=7:ACGFY_X,1:" ")
+3 DO Y
40 SET X=$PIECE(ACGDT2,U,5)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
41 SET ACGFY=$EXTRACT($PIECE(ACGDT3,U,18),2)
+1 IF ACGFY=""
SET ACGFY=$PIECE(ACGDT1,U,3)
SET ACGFY=$SELECT($EXTRACT(ACGFY,4,5)>9:$EXTRACT(ACGFY,3)+1,1:$EXTRACT(ACGFY,3))
IF $LENGTH(ACGFY)=2
SET ACGFY=$EXTRACT(ACGFY,2)
SET $PIECE(ACGIHS,U,4)=9_ACGFY
+2 SET X=$EXTRACT($PIECE(ACGDT2,U,6),1,7)
SET X=$SELECT($LENGTH(X)=7:ACGFY_X,1:" ")
+3 DO Y
42 SET X=$PIECE(ACGDT2,U,7)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
43 SET X=$PIECE(ACGDT2,U,8)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
44 SET X=$PIECE(ACGDT2,U,9)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
45 SET X=$EXTRACT($PIECE(ACGDT2,U,10))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
46 SET X=$PIECE(ACGDT2,U,11)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
47 SET X=$PIECE(ACGDT2,U,12)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
48 SET X=$PIECE(ACGDT2,U,13)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
49 SET X=$PIECE(ACGDT2,U,14)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
50 SET X=$PIECE(ACGDT2,U,15)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 11-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",11-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
51 SET X=$EXTRACT($PIECE(ACGDT2,U,16))
SET X=$SELECT(X]"":X,1:"2")
+1 DO Y
52 SET X=$EXTRACT($PIECE(ACGDT2,U,17))
SET X=$SELECT("ABC"[$PIECE(ACGDT3,U,7):" ",X]"":X,1:" ")
+1 DO Y
53 SET X=$EXTRACT($PIECE(ACGDT2,U,18),1,4)
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
54 SET X=$EXTRACT($PIECE(ACGDT2,U,19),1,30)
+1 IF $LENGTH(X)<30
SET X=X_$JUSTIFY(" ",30-$LENGTH(X))
+2 DO Y
55 SET X=$EXTRACT($PIECE(ACGDT2,U,20),1,12)
+1 IF X]""
SET X=$SELECT($LENGTH(X)=9:X,$LENGTH(X)=12:$EXTRACT(X,2,10),1:"")
+2 IF X=""
SET X=" "
+3 DO Y
56 SET X=$EXTRACT($PIECE(ACGDT3,U,1))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
57 SET X=$EXTRACT($PIECE(ACGDT3,U,2))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
58 SET X=$EXTRACT($PIECE(ACGDT3,U,3))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
59 SET X=$PIECE(ACGDT3,U,4)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
60 SET X=$EXTRACT($PIECE(ACGDT3,U,5))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
61 SET X=$EXTRACT($PIECE(ACGDT3,U,6),1,4)
SET X=$SELECT(X]"":"MULT",1:" ")
+1 DO Y
62 SET X=$EXTRACT($PIECE(ACGDT3,U,7))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
63 SET X=$EXTRACT($PIECE(ACGDT3,U,8))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
64 SET X=$EXTRACT($PIECE(ACGDT3,U,9))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
65 SET X=$EXTRACT($PIECE(ACGDT3,U,10))
SET X=$SELECT(X]"":X,1:" ")
+1 DO Y
66 SET X=$PIECE(ACGDT3,U,11)
SET X=$SELECT('X:" ",$DATA(^AUTTSOB(X,0)):$PIECE(^(0),U),1:" ")
+1 DO Y
67 SET X=$EXTRACT($PIECE(ACGDT3,U,12),1,10)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
+4 KILL ACGX
68 SET X=$EXTRACT($PIECE(ACGDT3,U,13),1,10)
SET ACGSIGN=$SELECT($EXTRACT(X)="-":"-",1:"")
SET ACGX=""
+1 IF ACGSIGN="-"
SET X=$PIECE(X,"-",2)
+2 IF 10-$LENGTH(ACGSIGN)-$LENGTH(X)
SET $PIECE(ACGX,"0",10-$LENGTH(ACGSIGN)-$LENGTH(X))=""
SET X=ACGSIGN_ACGX_X
+3 DO Y
+4 KILL ACGX
69 SET X=$EXTRACT($PIECE(ACGDT3,U,14),1,12)
+1 IF $LENGTH(X)<12
SET X=X_$JUSTIFY(" ",12-$LENGTH(X))
+2 DO Y
70 SET X=" "
+1 DO Y
+2 KILL ACGX
+3 QUIT
Y SET ACGY=ACGY_X
+1 QUIT
