- 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
