- 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