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