ACGSCS ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT TO REVIEW CONTRACTS AND MODIFICATIONS; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ENTRY POINT TO REVIEW CONTRACTS AND MODIFICATIONS
;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS
CS ;XEP;TO REVIEW CONTRACTS AND MODIFICATIONS
I +^ACGS(ACGCNO,"DT")=15!(+^("DT")=17) S ACGDATA="SPP" D CS2 Q
F S ACGDATA="PHS" D CS2,INTEG Q:$D(ACGOUT)!$D(ACGQUIT)
Q:$D(ACGOUT)
K ACGQUIT
I ACGCNO=ACGRDA D COMMENTS
F ACGDATA="IHS","IND" D CS2
K ACGQUIT
Q
CS2 F D CS1 Q:$D(ACGQUIT)!$D(ACGOUT)
;K ACGQUIT
Q
CS1 W @IOF
I ACGDATA="IND",$P(^ACGS(ACGRDA,"DT2"),U)=""!($P(^("DT2"),U)=0) S ACGQUIT="" Q
S D0=ACGRDA
W @IOF
K DXS,DIP,DC,ACGQUIT
S ACGPGM=$S(ACGDATA["PHS":"^ACGPTCS",ACGDATA["IHS":"^ACGPIHS",ACGDATA["SPP":"^ACGPSP",1:"^ACGPIND")
D @ACGPGM
K DXS,DIP,DC,ACGOUT,ACGQUIT
S DIR(0)="LO^1:"_$S(ACGDATA["PHS":69,ACGDATA["IHS"!(ACGDATA["SPP"):23,1:16),DIR("A")="Which field(s)" W ! D DIR^ACGSDIC
Q:$D(ACGQUIT)
CS11 S ACGY=","_Y
I ACGDATA["PHS" D
.S:ACGY[",5,"&(ACG4'=236) ACGY=$P(ACGY,",5,")_",1005,"_$P(ACGY,",5,",2)
.S:ACGY[",28,"&(ACG4'=236) ACGY=$P(ACGY,",28,")_",1028,"_$P(ACGY,",28,",2)
.S:ACGY[",35,"&(ACG4'=236) ACGY=$P(ACGY,",35,")_",1035,"_$P(ACGY,",35,",2)
.S:ACGY[",37," ACGY=$P(ACGY,",37,")_","_$S(ACG4'=236:1037,1:37)_",1038,"_$P(ACGY,",37,",2)
.S:ACGY[",39," ACGY=$P(ACGY,",39,")_","_$S(ACG4'=236:1039,1:39)_",1040,"_$P(ACGY,",39,",2)
.S:ACGY[",41," ACGY=$P(ACGY,",41,")_","_$S(ACG4'=236:1041,1:41)_",1042,"_$P(ACGY,",41,",2)
.S:ACGY[",54," ACGY=$P(ACGY,",54,")_","_$S(ACG4'=236:1054,1:54)_","_$P(ACGY,",54,",2)
I ACGDATA["IHS" D
.S:ACGY[",1," ACGY=$P(ACGY,",1,")_",906,"_$P(ACGY,",1,",2)
.S:ACGY[",2," ACGY=$P(ACGY,",2,")_",929,"_$P(ACGY,",2,",2)
.S:ACGY[",3," ACGY=$P(ACGY,",3,")_",52,53,"_$P(ACGY,",3,",2)
I ACGDATA["SPP" D
.S:ACGY[",1," ACGY=$P(ACGY,",1,")_",1 1 TYPE OF PROCUREMENT ACTION,"_$P(ACGY,",1,",2)
.S:ACGY[",2," ACGY=$P(ACGY,",2,")_",301 2 PURCHASE/DELIVERY ORDER NO,"_$P(ACGY,",2,",2)
.S:ACGY[",4," ACGY=$P(ACGY,",4,")_",1005 4 VENDOR....................,"_$P(ACGY,",4,",2)
.S:ACGY[",5," ACGY=$P(ACGY,",5,")_",1005 4 VENDOR....................,"_$P(ACGY,",5,",2)
.S:ACGY[",6," ACGY=$P(ACGY,",6,")_",1005 4 VENDOR....................,"_$P(ACGY,",6,",2)
.S:ACGY[",7," ACGY=$P(ACGY,",7,")_",1005 4 VENDOR....................,"_$P(ACGY,",7,",2)
.S:ACGY[",8," ACGY=$P(ACGY,",8,")_",1005 4 VENDOR....................,"_$P(ACGY,",8,",2)
.S:ACGY[",9," ACGY=$P(ACGY,",9,")_","_$P(ACGY,",9,",2)
.S:ACGY[",3," ACGY=$P(ACGY,",3,")_",4 3 CONTRACTING OFFICE........,"_$P(ACGY,",3,",2)
.S:ACGY[",10," ACGY=$P(ACGY,",10,")_",23 10 AWARD DATE................,"_$P(ACGY,",10,",2)
.S:ACGY[",11," ACGY=$P(ACGY,",11,")_",24 11 START DATE................,"_$P(ACGY,",11,",2)
.S:ACGY[",12," ACGY=$P(ACGY,",12,")_",25 12 END DATE..................,"_$P(ACGY,",12,",2)
.S:ACGY[",13," ACGY=$P(ACGY,",13,")_",26 13 DOLLAR AMOUNT.............,"_$P(ACGY,",13,",2)
.S:ACGY[",14," ACGY=$P(ACGY,",14,")_",302 14 OBJECT CODE...............,"_$P(ACGY,",14,",2)
.S:ACGY[",15," ACGY=$P(ACGY,",15,")_",1005 4 VENDOR....................,"_$P(ACGY,",15,",2)
.S:ACGY[",16," ACGY=$P(ACGY,",16,")_",307 16 EXTENT COMPETED...........,"_$P(ACGY,",16,",2)
.S:ACGY[",17," ACGY=$P(ACGY,",17,")_",303 17 PREFERENCE PROGRAM........,"_$P(ACGY,",17,",2)
.S:ACGY[",18," ACGY=$P(ACGY,",18,")_",304 18 TYPE OF BUSINESS..........,"_$P(ACGY,",18,",2)
.S:ACGY[",19," ACGY=$P(ACGY,",19,")_",305 19 TYPE OF VENDOR............,"_$P(ACGY,",19,",2)
.S:ACGY[",20," ACGY=$P(ACGY,",20,")_",306 20 PROCUREMENT METHOD........,"_$P(ACGY,",20,",2)
.S:ACGY[",21," ACGY=$P(ACGY,",21,")_",16 21 A&A SERVICE CONTRACT......,"_$P(ACGY,",21,",2)
.S:ACGY[",22," ACGY=$P(ACGY,",22,")_",27 22 PURPOSE CODE..............,"_$P(ACGY,",22,",2)
.S:ACGY[",23," ACGY=$P(ACGY,",23,")_",115 23 BUYER'S INITIALS..........,"_$P(ACGY,",23,",2)
S:$E(ACGY,$L(ACGY))="," ACGY=$E(ACGY,1,$L(ACGY)-1)
S:$E(ACGY)="," ACGY=$E(ACGY,2,$L(ACGY))
S DR=""
F ACGI=1:1:$L(ACGY,",") S ACGDR=$P(ACGY,",",ACGI) S:ACGDATA'["PHS"&(ACGDATA'["SPP") ACGDR=ACGDR+$S(ACGDATA["IHS":99,1:200) S DR=DR_ACGDR_$S(ACGDATA'["SPP":"T;",1:";")
S DIE="^ACGS(",DA=ACGRDA,DR="1099////"_DT_";"_DR
W !
D DIE^ACGSDIC
Q
INTEG K ACGXX,^TMP("ACG",$J),ACGQUIT
S ACGRD=$P(^ACGS(ACGRDA,0),U,3)
D EN2^ACGSRQ
K ^TMP("ACG",$J,"T")
I $D(^TMP("ACG",$J,ACG2)) W *7,"This contract action has the following errors:" D EN2^ACGSRQP W !!,"You must correct these errors before you proceed." D HOLD^ACGSMENU
S ACGQUIT=""
Q:'$D(ACGXX)
S X=0,Y=""
F S X=$O(ACGXX(X)) Q:'X S Y=Y_X_","
D CS11
K X,Y
Q
W !
D DIE^ACGSDIC,PRINT:ACGDATA["PHS"
Q
PRINT ;EP;TO PRINT INDIVIDUAL ACTION
S DIR(0)="YO",DIR("A")="Print Code Sheet Now",DIR("B")="NO"
W !
D DIR^ACGSDIC
Q:$G(Y)'=1
S ZTRTN="P1^ACGSCS",ZTDESC="CONTRACT ACTION SUMMARY"
D ^ACGSZIS
I '$D(IO("Q")),'$D(ACGQUIT) D P1
Q
P1 ;EP;
I '$D(ZTQUEUED) S (ACGIOP,IOP)=ION D ^%ZIS I POP S ACGQUIT="" Q
U IO
S D0=ACGRDA
K DXS,DIP,DC,ACGQUIT
D ^ACGPTCS
K DXS,DIP,DC,ACGOUT,ACGQUIT
W @IOF
D DONE^ACGSZIS
Q
ACGSCS ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT TO REVIEW CONTRACTS AND MODIFICATIONS; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ENTRY POINT TO REVIEW CONTRACTS AND MODIFICATIONS
+3 ;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS
CS ;XEP;TO REVIEW CONTRACTS AND MODIFICATIONS
+1 IF +^ACGS(ACGCNO,"DT")=15!(+^("DT")=17)
SET ACGDATA="SPP"
DO CS2
QUIT
+2 FOR
SET ACGDATA="PHS"
DO CS2
DO INTEG
IF $DATA(ACGOUT)!$DATA(ACGQUIT)
QUIT
+3 IF $DATA(ACGOUT)
QUIT
+4 KILL ACGQUIT
+5 IF ACGCNO=ACGRDA
DO COMMENTS
+6 FOR ACGDATA="IHS","IND"
DO CS2
+7 KILL ACGQUIT
+8 QUIT
CS2 FOR
DO CS1
IF $DATA(ACGQUIT)!$DATA(ACGOUT)
QUIT
+1 ;K ACGQUIT
+2 QUIT
CS1 WRITE @IOF
+1 IF ACGDATA="IND"
IF $PIECE(^ACGS(ACGRDA,"DT2"),U)=""!($PIECE(^("DT2"),U)=0)
SET ACGQUIT=""
QUIT
+2 SET D0=ACGRDA
+3 WRITE @IOF
+4 KILL DXS,DIP,DC,ACGQUIT
+5 SET ACGPGM=$SELECT(ACGDATA["PHS":"^ACGPTCS",ACGDATA["IHS":"^ACGPIHS",ACGDATA["SPP":"^ACGPSP",1:"^ACGPIND")
+6 DO @ACGPGM
+7 KILL DXS,DIP,DC,ACGOUT,ACGQUIT
+8 SET DIR(0)="LO^1:"_$SELECT(ACGDATA["PHS":69,ACGDATA["IHS"!(ACGDATA["SPP"):23,1:16)
SET DIR("A")="Which field(s)"
WRITE !
DO DIR^ACGSDIC
+9 IF $DATA(ACGQUIT)
QUIT
CS11 SET ACGY=","_Y
+1 IF ACGDATA["PHS"
Begin DoDot:1
+2 IF ACGY[",5,"&(ACG4'=236)
SET ACGY=$PIECE(ACGY,",5,")_",1005,"_$PIECE(ACGY,",5,",2)
+3 IF ACGY[",28,"&(ACG4'=236)
SET ACGY=$PIECE(ACGY,",28,")_",1028,"_$PIECE(ACGY,",28,",2)
+4 IF ACGY[",35,"&(ACG4'=236)
SET ACGY=$PIECE(ACGY,",35,")_",1035,"_$PIECE(ACGY,",35,",2)
+5 IF ACGY[",37,"
SET ACGY=$PIECE(ACGY,",37,")_","_$SELECT(ACG4'=236:1037,1:37)_",1038,"_$PIECE(ACGY,",37,",2)
+6 IF ACGY[",39,"
SET ACGY=$PIECE(ACGY,",39,")_","_$SELECT(ACG4'=236:1039,1:39)_",1040,"_$PIECE(ACGY,",39,",2)
+7 IF ACGY[",41,"
SET ACGY=$PIECE(ACGY,",41,")_","_$SELECT(ACG4'=236:1041,1:41)_",1042,"_$PIECE(ACGY,",41,",2)
+8 IF ACGY[",54,"
SET ACGY=$PIECE(ACGY,",54,")_","_$SELECT(ACG4'=236:1054,1:54)_","_$PIECE(ACGY,",54,",2)
End DoDot:1
+9 IF ACGDATA["IHS"
Begin DoDot:1
+10 IF ACGY[",1,"
SET ACGY=$PIECE(ACGY,",1,")_",906,"_$PIECE(ACGY,",1,",2)
+11 IF ACGY[",2,"
SET ACGY=$PIECE(ACGY,",2,")_",929,"_$PIECE(ACGY,",2,",2)
+12 IF ACGY[",3,"
SET ACGY=$PIECE(ACGY,",3,")_",52,53,"_$PIECE(ACGY,",3,",2)
End DoDot:1
+13 IF ACGDATA["SPP"
Begin DoDot:1
+14 IF ACGY[",1,"
SET ACGY=$PIECE(ACGY,",1,")_",1 1 TYPE OF PROCUREMENT ACTION,"_$PIECE(ACGY,",1,",2)
+15 IF ACGY[",2,"
SET ACGY=$PIECE(ACGY,",2,")_",301 2 PURCHASE/DELIVERY ORDER NO,"_$PIECE(ACGY,",2,",2)
+16 IF ACGY[",4,"
SET ACGY=$PIECE(ACGY,",4,")_",1005 4 VENDOR....................,"_$PIECE(ACGY,",4,",2)
+17 IF ACGY[",5,"
SET ACGY=$PIECE(ACGY,",5,")_",1005 4 VENDOR....................,"_$PIECE(ACGY,",5,",2)
+18 IF ACGY[",6,"
SET ACGY=$PIECE(ACGY,",6,")_",1005 4 VENDOR....................,"_$PIECE(ACGY,",6,",2)
+19 IF ACGY[",7,"
SET ACGY=$PIECE(ACGY,",7,")_",1005 4 VENDOR....................,"_$PIECE(ACGY,",7,",2)
+20 IF ACGY[",8,"
SET ACGY=$PIECE(ACGY,",8,")_",1005 4 VENDOR....................,"_$PIECE(ACGY,",8,",2)
+21 IF ACGY[",9,"
SET ACGY=$PIECE(ACGY,",9,")_","_$PIECE(ACGY,",9,",2)
+22 IF ACGY[",3,"
SET ACGY=$PIECE(ACGY,",3,")_",4 3 CONTRACTING OFFICE........,"_$PIECE(ACGY,",3,",2)
+23 IF ACGY[",10,"
SET ACGY=$PIECE(ACGY,",10,")_",23 10 AWARD DATE................,"_$PIECE(ACGY,",10,",2)
+24 IF ACGY[",11,"
SET ACGY=$PIECE(ACGY,",11,")_",24 11 START DATE................,"_$PIECE(ACGY,",11,",2)
+25 IF ACGY[",12,"
SET ACGY=$PIECE(ACGY,",12,")_",25 12 END DATE..................,"_$PIECE(ACGY,",12,",2)
+26 IF ACGY[",13,"
SET ACGY=$PIECE(ACGY,",13,")_",26 13 DOLLAR AMOUNT.............,"_$PIECE(ACGY,",13,",2)
+27 IF ACGY[",14,"
SET ACGY=$PIECE(ACGY,",14,")_",302 14 OBJECT CODE...............,"_$PIECE(ACGY,",14,",2)
+28 IF ACGY[",15,"
SET ACGY=$PIECE(ACGY,",15,")_",1005 4 VENDOR....................,"_$PIECE(ACGY,",15,",2)
+29 IF ACGY[",16,"
SET ACGY=$PIECE(ACGY,",16,")_",307 16 EXTENT COMPETED...........,"_$PIECE(ACGY,",16,",2)
+30 IF ACGY[",17,"
SET ACGY=$PIECE(ACGY,",17,")_",303 17 PREFERENCE PROGRAM........,"_$PIECE(ACGY,",17,",2)
+31 IF ACGY[",18,"
SET ACGY=$PIECE(ACGY,",18,")_",304 18 TYPE OF BUSINESS..........,"_$PIECE(ACGY,",18,",2)
+32 IF ACGY[",19,"
SET ACGY=$PIECE(ACGY,",19,")_",305 19 TYPE OF VENDOR............,"_$PIECE(ACGY,",19,",2)
+33 IF ACGY[",20,"
SET ACGY=$PIECE(ACGY,",20,")_",306 20 PROCUREMENT METHOD........,"_$PIECE(ACGY,",20,",2)
+34 IF ACGY[",21,"
SET ACGY=$PIECE(ACGY,",21,")_",16 21 A&A SERVICE CONTRACT......,"_$PIECE(ACGY,",21,",2)
+35 IF ACGY[",22,"
SET ACGY=$PIECE(ACGY,",22,")_",27 22 PURPOSE CODE..............,"_$PIECE(ACGY,",22,",2)
+36 IF ACGY[",23,"
SET ACGY=$PIECE(ACGY,",23,")_",115 23 BUYER'S INITIALS..........,"_$PIECE(ACGY,",23,",2)
End DoDot:1
+37 IF $EXTRACT(ACGY,$LENGTH(ACGY))=","
SET ACGY=$EXTRACT(ACGY,1,$LENGTH(ACGY)-1)
+38 IF $EXTRACT(ACGY)=","
SET ACGY=$EXTRACT(ACGY,2,$LENGTH(ACGY))
+39 SET DR=""
+40 FOR ACGI=1:1:$LENGTH(ACGY,",")
SET ACGDR=$PIECE(ACGY,",",ACGI)
IF ACGDATA'["PHS"&(ACGDATA'["SPP")
SET ACGDR=ACGDR+$SELECT(ACGDATA["IHS":99,1:200)
SET DR=DR_ACGDR_$SELECT(ACGDATA'["SPP":"T;",1:";")
+41 SET DIE="^ACGS("
SET DA=ACGRDA
SET DR="1099////"_DT_";"_DR
+42 WRITE !
+43 DO DIE^ACGSDIC
+44 QUIT
INTEG KILL ACGXX,^TMP("ACG",$JOB),ACGQUIT
+1 SET ACGRD=$PIECE(^ACGS(ACGRDA,0),U,3)
+2 DO EN2^ACGSRQ
+3 KILL ^TMP("ACG",$JOB,"T")
+4 IF $DATA(^TMP("ACG",$JOB,ACG2))
WRITE *7,"This contract action has the following errors:"
DO EN2^ACGSRQP
WRITE !!,"You must correct these errors before you proceed."
DO HOLD^ACGSMENU
+5 SET ACGQUIT=""
+6 IF '$DATA(ACGXX)
QUIT
+7 SET X=0
SET Y=""
+8 FOR
SET X=$ORDER(ACGXX(X))
IF 'X
QUIT
SET Y=Y_X_","
+9 DO CS11
+10 KILL X,Y
+11 QUIT
SET DIE="^ACGS("
SET DR="[ACG COMMENTS]"
+1 WRITE !
+2 DO DIE^ACGSDIC
IF ACGDATA["PHS"
DO PRINT
+3 QUIT
PRINT ;EP;TO PRINT INDIVIDUAL ACTION
+1 SET DIR(0)="YO"
SET DIR("A")="Print Code Sheet Now"
SET DIR("B")="NO"
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF $GET(Y)'=1
QUIT
+5 SET ZTRTN="P1^ACGSCS"
SET ZTDESC="CONTRACT ACTION SUMMARY"
+6 DO ^ACGSZIS
+7 IF '$DATA(IO("Q"))
IF '$DATA(ACGQUIT)
DO P1
+8 QUIT
P1 ;EP;
+1 IF '$DATA(ZTQUEUED)
SET (ACGIOP,IOP)=ION
DO ^%ZIS
IF POP
SET ACGQUIT=""
QUIT
+2 USE IO
+3 SET D0=ACGRDA
+4 KILL DXS,DIP,DC,ACGQUIT
+5 DO ^ACGPTCS
+6 KILL DXS,DIP,DC,ACGOUT,ACGQUIT
+7 WRITE @IOF
+8 DO DONE^ACGSZIS
+9 QUIT
