Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACGSTAR1

ACGSTAR1.m

Go to the documentation of this file.
  1. 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
  1. ;;ENTRY POINT FOR CONTRACT PROCESSING CONT'D
  1. KILL ;EP;TO KILL ALL VARIABLES
  1. D KILL^ACGSKILL
  1. Q
  1. KILL1 ;EP;TO KILL SELECTED VARIABLES
  1. D KILL1^ACGSKILL
  1. Q
  1. VND ;EP;TO LOOK UP VENDOR
  1. S DIR(0)="SO^1:Contractor;2:Contract Number",DIR("A")="Which one"
  1. D DIR^ACGSDIC
  1. Q:$D(ACGQUIT)!(+Y<1)
  1. S ACG4=$P(ACGPARA,U,3)
  1. I ACG4=236 S DIC="^ACGS(",DIC(0)="AEMQZ",DIC("A")="Contract Number..........: ",DIC("S")="I $D(^ACGS(""C"",+Y))"
  1. E I ACGY=1 S DIC="^AUTTVNDR(",DIC(0)="AEMQZ",DIC("A")="Contractor...............: "
  1. 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))"
  1. W !
  1. D DIC^ACGSDIC
  1. I +Y<1!$D(ACGQUIT) K ACGQUIT Q
  1. VND1 ;EP
  1. I $D(ACGVDA) S Y=ACGVDA
  1. S ACG4=$P(ACGPARA,U,3)
  1. I ACGY=2,ACG4'=236 Q:'$D(^ACGS(+Y,10)) S Y=+^ACGS(+Y,10)
  1. S:ACG4'=236 ACG5DA=+Y
  1. S:ACG4=236 ACG5DA=$P(^ACGS(+Y,"DT"),U,5)
  1. I ACG4'=236,'$D(^AUTTVNDR(+Y,0)) Q
  1. D:ACG4'=236 ^ACGSVITG
  1. Q:$D(ACGQUIT)
  1. D ^ACGSVCTR
  1. Q
  1. VNDUP ;EP;TO UPDATE VENDOR CONTRACT DATA
  1. S:'$D(^AUTTVNDR(ACG5DA,"CN",0)) ^AUTTVNDR(ACG5DA,"CN",0)="^9999999.1112^^"
  1. S ACG(2)=$E($P(^ACGS(ACGRDA,"DT"),U,2),1,12)
  1. F ACG=1:1:5 S ACG(21+ACG)=$P(^ACGS(ACGRDA,"DT1"),U,ACG)
  1. 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
  1. I $D(ACGNEW),ACG1DA'=15,ACG1DA'=17 D
  1. .S DIC(0)="L",X=$E(ACG(2),1,9),DIC("DR")=DR
  1. .D FILE^ACGSDIC
  1. .S ACGCDA=+Y,DIE="^ACGS(",DA=ACGRDA,DR=".05////"_ACGCDA D DIE^ACGSDIC
  1. Q
  1. INACT ;EP;TO INACTIVATE CONTRACT
  1. D VND^ACGSTAR1
  1. I $D(ACGQUIT)!'$D(ACGCNO) K ACGQUIT Q
  1. 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)
  1. W !!,"Change Status Code:"
  1. D DIR^ACGSDIC
  1. I $D(ACGQUIT)!(Y<1) K ACGQUIT Q
  1. S DA=ACGCNO,DIE="^ACGS(",DR="121////"_Y_$S(Y=2:";154T",Y=3:";155T",1:"")
  1. W !
  1. D DIE^ACGSDIC
  1. Q