ACGSNC ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT FOR NEW CONTRACTS; [ 03/27/2000 5:49 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ENTRY POINT TO CREATE ALL NEW CONTRACTS
N Y
NC S DIR(0)="SO^D:Definitive Contract;I:Indefinite Delivery Contract;G:Delivery Order > $100,000;N:Other Federal Source;L:Letter Contract;P:Small Purchase",DIR("A")="Type Procurement Action..",ACGNEW=""
W @IOF
D DIR^ACGSDIC
Q:$D(ACGQUIT)
S (ACG1,ACGNC,ACGFLDS,ACGFLDSS)=Y,ACG1DA=$S(Y="D":1,Y="I":2,Y="G":14,Y="N":16,Y="L":4,Y="P":15)
F D VND Q:$D(ACGQUIT)!$D(ACRDOCDA)
K ACGQUIT
Q
VND D VND^ACGSTAR1:'$D(ACGVDA),VND1^ACGSTAR1:$D(ACGVDA)
Q:+Y<1!$D(ACGQUIT)
S DIR(0)="YO",DIR("A")="Create a new "_$S(ACG1DA<14:"contract",ACG1DA=15:"small purchase",1:"delivery order")_" (Y/N)"
W !
D DIR^ACGSDIC
I $D(ACGQUIT)!(Y'=1) K ACGNEW Q
W ! D WAIT^DICD
NC1 ;PEP;TO CREATE NEW CIS ENTRY FROM ARMS
;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS
S ACGPARA=^ACGPARA(1,0)
S (ACGCNO,ACGNEW)="",(ACG2,ACG3)="",ACG4=$P(ACGPARA,U,3),X=0,DIC="^ACGS(",DIC(0)="L"
DINUM ;
S DINUM=$S($P(^ACGS(0),U,3)>(ACG4_"00000"):$P(^(0),U,3),1:(ACG4_"00000")) F S DINUM=DINUM+1 Q:'$D(^ACGS(DINUM,0))
D FILE^ACGSDIC
D NOW^%DTC
S DIE="^ACGS(",(DA,ACGRDA,ACGCNO)=+Y,DR=".02////0;.03////"_+Y_";.07////"_%_";.08////"_DUZ_";1////"_ACG1DA_";4////"_ACG4_";16////2;1005////"_ACG5DA_";103////"_ACGFY_";121////1;1099////"_DT
S X=$E($P(^VA(200,DUZ,0),U,2),1,3)
I X]"" D
.I $L(X)<3 F I=1:1:3-$L(X) S X=X_" "
.S DR=DR_";115////"_X
S:ACG1DA'=15 DR=DR_";14////99;29////2;31////E;32////0;45////3;51////2;52////2;56////2;57////2;58////2;60////2;104////1;107////2;108////2;109////1;110////2;111////1;113////2;114////1"
I ACG1DA=15!(ACG1DA=17) D
.S ACGTOB=^AUTTVNDR(ACG5DA,11),ACGTOV=$P(ACGTOB,U,28),ACGTOB=$P(ACGTOB,U,27)
.S DR=DR_";304////"_ACGTOB_";305////"_ACGTOV
.S:$D(ACRDOCDA) DR=DR_";301////"_$P(^ACRDOC(ACRDOCDA,0),U,2)
S:$D(ACRDOCDA) DR=DR_";2////"_$P(^ACRDOC(ACRDOCDA,0),U,2)_";.06////"_ACRDOCDA_";26////"_($P(^ACROBL(ACRDOCDA,0),".")+$S($E($P(^(0),".",2))>4:1,1:0))_";23////"_ACG23_";24////"_ACG24_";25////"_ACG25_";302////"_ACG302
D DIE^ACGSDIC
F ACG="DT2","DT3" S:'$D(^ACGS(ACGRDA,ACG)) ^ACGS(ACGRDA,ACG)=""
D:'$D(ACRDOCDA) PF^ACGSTART
Q
SEQ I '$P(^ACGPARA(1,0),U,4) S $P(^ACGPARA(1,0),U,4)=0
L +^ACGPARA(1,0):4 I '$T G SEQ
S ACGSEQ=$P(^ACGPARA(1,0),U,4)+1,$P(^(0),U,4)=ACGSEQ
L -^ACGPARA(1,0):0
I $L(ACGSEQ)<4 F ACGLENG=1:1:(4-$L(ACGSEQ)) S ACGSEQ="0"_ACGSEQ
Q
ACGSNC ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT FOR NEW CONTRACTS; [ 03/27/2000 5:49 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ENTRY POINT TO CREATE ALL NEW CONTRACTS
+3 NEW Y
NC SET DIR(0)="SO^D:Definitive Contract;I:Indefinite Delivery Contract;G:Delivery Order > $100,000;N:Other Federal Source;L:Letter Contract;P:Small Purchase"
SET DIR("A")="Type Procurement Action.."
SET ACGNEW=""
+1 WRITE @IOF
+2 DO DIR^ACGSDIC
+3 IF $DATA(ACGQUIT)
QUIT
+4 SET (ACG1,ACGNC,ACGFLDS,ACGFLDSS)=Y
SET ACG1DA=$SELECT(Y="D":1,Y="I":2,Y="G":14,Y="N":16,Y="L":4,Y="P":15)
+5 FOR
DO VND
IF $DATA(ACGQUIT)!$DATA(ACRDOCDA)
QUIT
+6 KILL ACGQUIT
+7 QUIT
VND IF '$DATA(ACGVDA)
DO VND^ACGSTAR1
IF $DATA(ACGVDA)
DO VND1^ACGSTAR1
+1 IF +Y<1!$DATA(ACGQUIT)
QUIT
+2 SET DIR(0)="YO"
SET DIR("A")="Create a new "_$SELECT(ACG1DA<14:"contract",ACG1DA=15:"small purchase",1:"delivery order")_" (Y/N)"
+3 WRITE !
+4 DO DIR^ACGSDIC
+5 IF $DATA(ACGQUIT)!(Y'=1)
KILL ACGNEW
QUIT
+6 WRITE !
DO WAIT^DICD
NC1 ;PEP;TO CREATE NEW CIS ENTRY FROM ARMS
+1 ;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS
+2 SET ACGPARA=^ACGPARA(1,0)
+3 SET (ACGCNO,ACGNEW)=""
SET (ACG2,ACG3)=""
SET ACG4=$PIECE(ACGPARA,U,3)
SET X=0
SET DIC="^ACGS("
SET DIC(0)="L"
DINUM ;
+1 SET DINUM=$SELECT($PIECE(^ACGS(0),U,3)>(ACG4_"00000"):$PIECE(^(0),U,3),1:(ACG4_"00000"))
FOR
SET DINUM=DINUM+1
IF '$DATA(^ACGS(DINUM,0))
QUIT
+2 DO FILE^ACGSDIC
+3 DO NOW^%DTC
+4 SET DIE="^ACGS("
SET (DA,ACGRDA,ACGCNO)=+Y
SET DR=".02////0;.03////"_+Y_";.07////"_%_";.08////"_DUZ_";1////"_ACG1DA_";4////"_ACG4_";16////2;1005////"_ACG5DA_";103////"_ACGFY_";121////1;1099////"_DT
+5 SET X=$EXTRACT($PIECE(^VA(200,DUZ,0),U,2),1,3)
+6 IF X]""
Begin DoDot:1
+7 IF $LENGTH(X)<3
FOR I=1:1:3-$LENGTH(X)
SET X=X_" "
+8 SET DR=DR_";115////"_X
End DoDot:1
+9 IF ACG1DA'=15
SET DR=DR_";14////99;29////2;31////E;32////0;45////3;51////2;52////2;56////2;57////2;58////2;60////2;104////1;107////2;108////2;109////1;110////2;111////1;113////2;114////1"
+10 IF ACG1DA=15!(ACG1DA=17)
Begin DoDot:1
+11 SET ACGTOB=^AUTTVNDR(ACG5DA,11)
SET ACGTOV=$PIECE(ACGTOB,U,28)
SET ACGTOB=$PIECE(ACGTOB,U,27)
+12 SET DR=DR_";304////"_ACGTOB_";305////"_ACGTOV
+13 IF $DATA(ACRDOCDA)
SET DR=DR_";301////"_$PIECE(^ACRDOC(ACRDOCDA,0),U,2)
End DoDot:1
+14 IF $DATA(ACRDOCDA)
SET DR=DR_";2////"_$PIECE(^ACRDOC(ACRDOCDA,0),U,2)_";.06////"_ACRDOCDA_";26////"_($PIECE(^ACROBL(ACRDOCDA,0),".")+$SELECT($EXTRACT($PIECE(^(0),".",2))>4:1,1:0))_";23////"_ACG23_";24////"_ACG24_";25////"_ACG25_";302////"_ACG302
+15 DO DIE^ACGSDIC
+16 FOR ACG="DT2","DT3"
IF '$DATA(^ACGS(ACGRDA,ACG))
SET ^ACGS(ACGRDA,ACG)=""
+17 IF '$DATA(ACRDOCDA)
DO PF^ACGSTART
+18 QUIT
SEQ IF '$PIECE(^ACGPARA(1,0),U,4)
SET $PIECE(^ACGPARA(1,0),U,4)=0
+1 LOCK +^ACGPARA(1,0):4
IF '$TEST
GOTO SEQ
+2 SET ACGSEQ=$PIECE(^ACGPARA(1,0),U,4)+1
SET $PIECE(^(0),U,4)=ACGSEQ
+3 LOCK -^ACGPARA(1,0):0
+4 IF $LENGTH(ACGSEQ)<4
FOR ACGLENG=1:1:(4-$LENGTH(ACGSEQ))
SET ACGSEQ="0"_ACGSEQ
+5 QUIT
