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

ACGSTART.m

Go to the documentation of this file. 
  1. ACGSTART ;IHS/OIRM/DSD/THL,AEF - ENTRY POINT FOR CONTRACT PROCESSING; [ 03/27/2000  5:48 PM ]
  1.  ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
  1.  ;;ENTRY POINT FOR CONTRACT PROCESSING
  1. EN D FY1^ACGSEXP
  1.  I '+$G(ACGPARA) D SITE^ACGSPARA
  1.  Q:'+$G(ACGPARA)
  1.  F  D EN1 Q:$D(ACGQUIT)
  1. EXIT D KILL^ACGSTAR1
  1.  Q
  1. EN1 D HEAD^ACGSMENU
  1.  S ACGCOC=ACG4
  1.  S DIR(0)="SO^1:ADD Contract/Small Purchase;2:NEW Modification;3:EDIT Entry;4:CHANGE Activity Status;5:DELETE Modification",DIR("A")="          Which one"
  1.  W !!?32,"DATA ENTRY/EDIT"
  1.  D KILL1^ACGSTAR1
  1.  D DIR^ACGSDIC
  1.  Q:$D(ACGQUIT)
  1.  S:Y=1 ACGC="" S:Y=2 ACGCA=""
  1.  I Y=1 D ^ACGSNC K ACGQUIT Q
  1.  I Y=2 D NCA K ACGQUIT Q
  1.  I Y=3 D ^ACGSEDIT K ACGQUIT Q
  1.  I Y=4 D INACT^ACGSTAR1 K ACGQUIT Q
  1.  I Y=5 S ACGDELET="" D ^ACGSEDIT K ACGQUIT,ACGDELET Q
  1.  Q
  1. NCA S DIR(0)="SO^R:Contract mod (additional funds/performance);C:Contract mod (negotiated funds/performance);M:Contract mod (other than R, or C);PM:Small Purchase Modification;Q:Quarterly Report of Delivery Orders"
  1.  S DIR(0)=DIR(0)_";T:Termination for default;U:Termination for convenienc" ;G:Delivery Order against Agency Contract"
  1.  S DIR("A")="Type of Procurement Action",DIR("A",1)=" "
  1.  W @IOF
  1.  D DIR^ACGSDIC
  1.  Q:$D(ACGQUIT)
  1.  S (ACG1,ACGNCA,ACGFLDS,ACGFLDSS)=Y,ACG1DA=$O(^ACGTPA("B",Y,""))
  1. NCA1 D VND^ACGSTAR1
  1.  I '$D(ACGCNO) W !!,"Contract action cannot be created without identifying the contract." D HOLD^ACGSMENU Q
  1.  Q:'ACGCNO
  1.  S ACGNEW="" D EDIT1^ACGSEDIT
  1.  S DIR(0)="YO",DIR("A")="Create new contract action"
  1.  W !
  1.  D DIR^ACGSDIC
  1.  I $D(ACGQUIT)!(Y'=1) K ACGQUIT Q
  1.  I $P(^ACGS(ACGCNO,"DT"),U,13)'=$P(^AUTTVNDR(ACG5DA,11),U,26) D  Q
  1.  .W !!,*7,*7,"The TYPE OF BUSINESS listed for this Contractor under CONTRACTOR DATA",!,"does not match the TYPE OF BUSINESS from the original contract action.",!,"You must reconcile this difference and insure that the TYPE OF BUSINESS"
  1.  .W !,"listed on the original and ALL modifications matches the information on file",!,"under CONTRACTOR DATA for this contractor."
  1.  .D HOLD^ACGSMENU
  1.  .S ACGQUIT=""
  1. NUM I ACG1DA'=6 D
  1.  .L +^ACGS(ACGCNO,0):4 I '$T G NUM
  1.  .S ACGANO=$P(^ACGS(ACGCNO,0),U,2),(ACGANO,ACGAN)=ACGANO+1 S DA=ACGCNO,DIE="^ACGS(",DR=".02////"_ACGANO
  1.  .L -^ACGS(ACGCNO,0):0
  1.  .D DIE^ACGSDIC
  1.  I ACG1DA=6 D  Q:$D(ACGQUIT)!$D(ACGOUT)
  1.  .D QT,FY
  1.  .Q:$D(ACGQUIT)!$D(ACGOUT)
  1.  .S ACGANO=9_$E(ACGFY,2)_ACGQT,ACGAN=ACGANO
  1.  F ACGK=1:1:(3-$L(ACGANO)) S ACGANO="0"_ACGANO
  1.  G:$D(^ACGS("B",($E(ACGX,1,9)_ACGANO))) NUM
  1.  S ACG2=$E(ACGX,1,9)_ACGANO,ACG3="",ACG4=$P(ACGPARA,U,3)
  1.  S X=ACGAN,DIC="^ACGS(",DIC(0)="L"
  1.  S DIC("DR")=".02////"_ACGAN_";.03////"_ACGCNO_";.05////"_ACGCDA_";1////"_ACG1DA_";2////"_ACG2_";3////"_ACG3_";4////"_ACG4_";1005////"_ACG5DA_";51////2;52////2;58////2;103////"_ACGFY_";1099////"_DT_";16////"_$P(^ACGS(ACGCNO,"DT"),U,16)
  1.  S DIC("DR")=DIC("DR")_";21////1"
  1.  I ACG1DA=15!(ACG1DA=17) S ACGSP=^ACGS(ACGCNO,"SP"),DIC("DR")=DIC("DR")_";301////"_$P(ACGSP,U)_";302////"_$P(ACGSP,U,2)_";303////"_$P(ACGSP,U,3)_";304////"_$P(ACGSP,U,4)_";305////"_$P(ACGSP,U,5)_";306////"_$P(ACGSP,U,6)
  1.  E  S DIC("DR")=DIC("DR")
  1.  S ACGX=$E($P(^VA(200,DUZ,0),U,2),1,3)
  1.  I ACGX]"" D
  1.  .I $L(ACGX)<3 F I=1:1:3-$L(ACGX) S ACGX=ACGX_" "
  1.  .S DIC("DR")=DIC("DR")_";115////"_ACGX
  1.  W ! D WAIT^DICD W !
  1.  D FILE^ACGSDIC
  1.  S ACGRDA=+Y
  1.  D NOW^%DTC
  1.  S DR=".07////"_%_";.08////"_DUZ_";22////"_$P(^ACGS(ACGCNO,"DT1"),U)_";1037////"_$P(^(10),U,4)_";62////"_$P(^("DT3"),U,7),DIE="^ACGS(",DA=ACGRDA
  1.  D DIE^ACGSDIC
  1.  D @ACG1^ACGSRQD
  1. PF ;EP;TO PROCESS FIELDS FOR CONTRACT ACTION EDIT SEQUENCES
  1.  F ACGX="DT1","DT2","DT3" S:'$D(^ACGS(ACGRDA,ACGX)) ^ACGS(ACGRDA,ACGX)=""
  1. ACGSPF W @IOF
  1.  S DR=$P($T(@ACGFLDSS^ACGSRF),";;",2)_$S("MRDIL"'[ACGFLDSS:";115T",1:""),DIE="^ACGS(",DA=ACGRDA
  1.  S:"P"'=$E(ACGFLDSS) DR="2T;"_DR
  1.  D DIE^ACGSDIC
  1.  I "MRDIL"[$E(ACGFLDSS) S DIE="^ACGS(",DA=ACGRDA,DR=$P($T(@ACGFLDSS+1^ACGSRF),";;",2)_";115T" D DIE^ACGSDIC
  1.  I "MRDILGN"[$E(ACGFLDSS),$P(^ACGS(ACGRDA,"DT"),U,13)=10 S DIE="^ACGS(",DA=ACGRDA,DR="67T;68T;69T" D DIE^ACGSDIC
  1.  I $P(^ACGS(ACGRDA,"IHS"),U,16)="" W !!,*7,*7,"IT APPEARS THAT THE DATA ENTRY SEQUENCE HAS NOT BEEN COMPLETED.",!,"YOU MUST COMPLETE DATA ENTRY BEFORE PROCEEDING." D HOLD^ACGSMENU G PF
  1.  I "P"'=$E(ACGFLDS) D DOLLARS
  1.  D:$D(ACGNEW)&("P"'[$E(ACG1)) VNDUP^ACGSTAR1 K ACGNEW
  1.  D ^ACGSCS
  1.  Q
  1. DOLLARS I $P(^ACGS(ACGRDA,"DT1"),U,5),($P(^("DT2"),U,3)+$P(^("DT2"),U,5)+$P(^("DT2"),U,7))'=$P(^("DT1"),U,5) F  D  Q:($P(^ACGS(ACGRDA,"DT2"),U,3)+$P(^("DT2"),U,5)+$P(^("DT2"),U,7))=$P(^("DT1"),U,5)
  1.  .S DA=ACGRDA,DIE="^ACGS(",DR="1037T;38T;1039T;40T;1041T;42T"
  1.  .W !!,*7,"The amount allocated to all CAN's must equal ",$FN($P(^ACGS(ACGRDA,"DT1"),U,5),"P",0),!
  1.  .D DIE^ACGSDIC
  1.  Q
  1. QT ;EP;TO DETERMINE DATE RANGE FOR QUARTERS
  1.  S DIR(0)="SO^1:FIRST;2:SECOND;3:THIRD;4:FOURTH",DIR("A")="Quarter....",DIR("?")="Enter the quarter for the report"
  1.  W !
  1.  D DIR^ACGSDIC
  1.  Q:$D(ACGQUIT)
  1.  S ACGQT=+Y
  1.  Q
  1. FY S DIR(0)="FO^2:2^K:X'?2N X",DIR("A")="Fiscal Year",DIR("?")="Enter the last 2 digits of the Fiscal Year, e.g., '94' for 1994."
  1.  W !
  1.  D DIR^ACGSDIC
  1.  Q:$D(ACGQUIT)
  1.  S ACGFY=Y
  1.  Q