- 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
