ACGSTAR1 ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT FOR CONTRACT PROCESSING CONT'D; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ENTRY POINT FOR CONTRACT PROCESSING CONT'D
KILL ;EP;TO KILL ALL VARIABLES
D KILL^ACGSKILL
Q
KILL1 ;EP;TO KILL SELECTED VARIABLES
D KILL1^ACGSKILL
Q
VND ;EP;TO LOOK UP VENDOR
S DIR(0)="SO^1:Contractor;2:Contract Number",DIR("A")="Which one"
D DIR^ACGSDIC
Q:$D(ACGQUIT)!(+Y<1)
S ACG4=$P(ACGPARA,U,3)
I ACG4=236 S DIC="^ACGS(",DIC(0)="AEMQZ",DIC("A")="Contract Number..........: ",DIC("S")="I $D(^ACGS(""C"",+Y))"
E I ACGY=1 S DIC="^AUTTVNDR(",DIC(0)="AEMQZ",DIC("A")="Contractor...............: "
E I ACGY=2 S DIC="^ACGS(",DIC(0)="AEMQZ",DIC("A")="Contract Number..........: ",DIC("S")="Q:""^15^17^""[(U_+^ACGS(+Y,""DT"")_U) I $D(^ACGS(""C"",+Y))"
W !
D DIC^ACGSDIC
I +Y<1!$D(ACGQUIT) K ACGQUIT Q
VND1 ;EP
I $D(ACGVDA) S Y=ACGVDA
S ACG4=$P(ACGPARA,U,3)
I ACGY=2,ACG4'=236 Q:'$D(^ACGS(+Y,10)) S Y=+^ACGS(+Y,10)
S:ACG4'=236 ACG5DA=+Y
S:ACG4=236 ACG5DA=$P(^ACGS(+Y,"DT"),U,5)
I ACG4'=236,'$D(^AUTTVNDR(+Y,0)) Q
D:ACG4'=236 ^ACGSVITG
Q:$D(ACGQUIT)
D ^ACGSVCTR
Q
VNDUP ;EP;TO UPDATE VENDOR CONTRACT DATA
S:'$D(^AUTTVNDR(ACG5DA,"CN",0)) ^AUTTVNDR(ACG5DA,"CN",0)="^9999999.1112^^"
S ACG(2)=$E($P(^ACGS(ACGRDA,"DT"),U,2),1,12)
F ACG=1:1:5 S ACG(21+ACG)=$P(^ACGS(ACGRDA,"DT1"),U,ACG)
S DA(1)=ACG5DA,(DIE,DIC)="^AUTTVNDR("_ACG5DA_",""CN"",",DR="1////"_ACG(24)_";2////"_ACG(25)_";3////"_ACG(26)_";4////"_$E(ACG(22),1,30)_";1005////"_ACG(23)_";6////"_ACGRDA
I $D(ACGNEW),ACG1DA'=15,ACG1DA'=17 D
.S DIC(0)="L",X=$E(ACG(2),1,9),DIC("DR")=DR
.D FILE^ACGSDIC
.S ACGCDA=+Y,DIE="^ACGS(",DA=ACGRDA,DR=".05////"_ACGCDA D DIE^ACGSDIC
Q
INACT ;EP;TO INACTIVATE CONTRACT
D VND^ACGSTAR1
I $D(ACGQUIT)!'$D(ACGCNO) K ACGQUIT Q
S DIR(0)="SO^1:ACTIVE;2:COMPLETED PHYSICALLY;3:COMPLETED ADMINISTRATIVELY",DIR("A")="Status Code",DIR("A",1)=" ",DIR("B")=$P(^ACGS(ACGCNO,"IHS"),U,22)
W !!,"Change Status Code:"
D DIR^ACGSDIC
I $D(ACGQUIT)!(Y<1) K ACGQUIT Q
S DA=ACGCNO,DIE="^ACGS(",DR="121////"_Y_$S(Y=2:";154T",Y=3:";155T",1:"")
W !
D DIE^ACGSDIC
Q
ACGSTAR1 ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT FOR CONTRACT PROCESSING CONT'D; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ENTRY POINT FOR CONTRACT PROCESSING CONT'D
KILL ;EP;TO KILL ALL VARIABLES
+1 DO KILL^ACGSKILL
+2 QUIT
KILL1 ;EP;TO KILL SELECTED VARIABLES
+1 DO KILL1^ACGSKILL
+2 QUIT
VND ;EP;TO LOOK UP VENDOR
+1 SET DIR(0)="SO^1:Contractor;2:Contract Number"
SET DIR("A")="Which one"
+2 DO DIR^ACGSDIC
+3 IF $DATA(ACGQUIT)!(+Y<1)
QUIT
+4 SET ACG4=$PIECE(ACGPARA,U,3)
+5 IF ACG4=236
SET DIC="^ACGS("
SET DIC(0)="AEMQZ"
SET DIC("A")="Contract Number..........: "
SET DIC("S")="I $D(^ACGS(""C"",+Y))"
+6 IF '$TEST
IF ACGY=1
SET DIC="^AUTTVNDR("
SET DIC(0)="AEMQZ"
SET DIC("A")="Contractor...............: "
+7 IF '$TEST
IF ACGY=2
SET DIC="^ACGS("
SET DIC(0)="AEMQZ"
SET DIC("A")="Contract Number..........: "
SET DIC("S")="Q:""^15^17^""[(U_+^ACGS(+Y,""DT"")_U) I $D(^ACGS(""C"",+Y))"
+8 WRITE !
+9 DO DIC^ACGSDIC
+10 IF +Y<1!$DATA(ACGQUIT)
KILL ACGQUIT
QUIT
VND1 ;EP
+1 IF $DATA(ACGVDA)
SET Y=ACGVDA
+2 SET ACG4=$PIECE(ACGPARA,U,3)
+3 IF ACGY=2
IF ACG4'=236
IF '$DATA(^ACGS(+Y,10))
QUIT
SET Y=+^ACGS(+Y,10)
+4 IF ACG4'=236
SET ACG5DA=+Y
+5 IF ACG4=236
SET ACG5DA=$PIECE(^ACGS(+Y,"DT"),U,5)
+6 IF ACG4'=236
IF '$DATA(^AUTTVNDR(+Y,0))
QUIT
+7 IF ACG4'=236
DO ^ACGSVITG
+8 IF $DATA(ACGQUIT)
QUIT
+9 DO ^ACGSVCTR
+10 QUIT
VNDUP ;EP;TO UPDATE VENDOR CONTRACT DATA
+1 IF '$DATA(^AUTTVNDR(ACG5DA,"CN",0))
SET ^AUTTVNDR(ACG5DA,"CN",0)="^9999999.1112^^"
+2 SET ACG(2)=$EXTRACT($PIECE(^ACGS(ACGRDA,"DT"),U,2),1,12)
+3 FOR ACG=1:1:5
SET ACG(21+ACG)=$PIECE(^ACGS(ACGRDA,"DT1"),U,ACG)
+4 SET DA(1)=ACG5DA
SET (DIE,DIC)="^AUTTVNDR("_ACG5DA_",""CN"","
SET DR="1////"_ACG(24)_";2////"_ACG(25)_";3////"_ACG(26)_";4////"_$EXTRACT(ACG(22),1,30)_";1005////"_ACG(23)_";6////"_ACGRDA
+5 IF $DATA(ACGNEW)
IF ACG1DA'=15
IF ACG1DA'=17
Begin DoDot:1
+6 SET DIC(0)="L"
SET X=$EXTRACT(ACG(2),1,9)
SET DIC("DR")=DR
+7 DO FILE^ACGSDIC
+8 SET ACGCDA=+Y
SET DIE="^ACGS("
SET DA=ACGRDA
SET DR=".05////"_ACGCDA
DO DIE^ACGSDIC
End DoDot:1
+9 QUIT
INACT ;EP;TO INACTIVATE CONTRACT
+1 DO VND^ACGSTAR1
+2 IF $DATA(ACGQUIT)!'$DATA(ACGCNO)
KILL ACGQUIT
QUIT
+3 SET DIR(0)="SO^1:ACTIVE;2:COMPLETED PHYSICALLY;3:COMPLETED ADMINISTRATIVELY"
SET DIR("A")="Status Code"
SET DIR("A",1)=" "
SET DIR("B")=$PIECE(^ACGS(ACGCNO,"IHS"),U,22)
+4 WRITE !!,"Change Status Code:"
+5 DO DIR^ACGSDIC
+6 IF $DATA(ACGQUIT)!(Y<1)
KILL ACGQUIT
QUIT
+7 SET DA=ACGCNO
SET DIE="^ACGS("
SET DR="121////"_Y_$SELECT(Y=2:";154T",Y=3:";155T",1:"")
+8 WRITE !
+9 DO DIE^ACGSDIC
+10 QUIT
