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

ACRFCIS.m

Go to the documentation of this file.
  1. ACRFCIS ;IHS/OIRM/DSD/THL,AEF - ARMS TO CIS INTERFACE; [ 01/03/2003 8:01 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,5**;NOV 05, 2001
  1. ;;ROUTINE USED TO MANAGE INTERFACE BETWEEN ARMS AND THE CONTRACT
  1. ;;INFORMATION SYSTEM (CIS)
  1. EN D EN1
  1. EXIT K ACR,ACRQUIT
  1. D EXIT^ACGSEXIT
  1. Q
  1. EN1 D HOME^ACGSMENU
  1. S (ACGRDA,ACRCISDA)=$P(^ACRDOC(ACRDOCDA,0),U,16)
  1. S ACRPO=$P(^ACRDOC(ACRDOCDA,0),U,2)
  1. S (ACRVDA,ACG5DA)=$P(^ACRDOC(ACRDOCDA,"PO"),U,5)
  1. S ACGPARA=^ACGPARA(1,0)
  1. S ACG4=$P(ACGPARA,U,3)
  1. D VCHK
  1. I $D(ACRQUIT) K ACRQUIT Q
  1. D EINCHK
  1. I $D(ACRQUIT) K ACRQUIT Q
  1. I 'ACRCISDA D Q
  1. .D ADD
  1. .D EN1:$P(^ACRDOC(ACRDOCDA,0),U,16)
  1. I ACRCISDA D EDIT
  1. Q
  1. ADD ;EP;
  1. S ACG23=$P(^ACRDOC(ACRDOCDA,"PO"),U)
  1. S ACG5DA=$P(^ACRDOC(ACRDOCDA,"PO"),U,5)
  1. S ACG25=$P(^ACRDOC(ACRDOCDA,"PO"),U,12)
  1. S ACGPARA=^ACGPARA(1,0) ; *** ACR*2.1*5.09
  1. S ACG24=ACG23
  1. S ACG302=$O(^ACRSS("C",ACRDOCDA,0))
  1. D VCHK
  1. I $D(ACRQUIT) K ACRQUIT Q
  1. D EINCHK
  1. I $D(ACRQUIT) K ACRQUIT Q
  1. I ACG302,$D(^ACRSS(ACG302,0)) S ACG302=$P(^(0),U,4)
  1. S DIR(0)="SO^1:New Contract (Definitive or Indefinite Delivery);2:Contract Modification;3:Small Purchase Action"
  1. S DIR("A")="Which one"
  1. D DIR^ACRFDIC
  1. Q:+Y<1
  1. I Y=1 D ^ACGSNC
  1. I Y=3 D G ADD1
  1. .D FY^ACGSEXP
  1. .S (ACG1,ACGNC,ACGFLDS,ACGFLDSS)="P"
  1. .S ACG1DA=15
  1. .D NC1^ACGSNC
  1. ADD1 I $D(ACGRDA),ACGRDA,$D(^ACGS(ACGRDA,0)) D
  1. .S DA=ACRDOCDA
  1. .S DIE="^ACRDOC("
  1. .S DR=".16////"_ACGRDA
  1. .D DIE^ACRFDIC
  1. .N ACROBL0
  1. .S (ACRSSDA,ACROBL0)=0
  1. .F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
  1. ..S:$D(^ACRSS(ACRSSDA,"DT")) ACROBL0=ACROBL0+$P(^("DT"),U,4)
  1. .S DA=ACGRDA
  1. .S DIE="^ACGS("
  1. .S DR="26////"_+ACROBL0
  1. .D DIE^ACRFDIC
  1. .S DA=ACGRDA
  1. .S DIE="^ACGS("
  1. .S DR="307T;303T;306T;27 22 PROC PURPOSE CODE........"
  1. .W !
  1. .D DIE^ACRFDIC
  1. Q
  1. BPAADD ;EP;TO ADD SMALL PURCHASE DATA FOR A BPA
  1. S ACG0=^ACGS(ACRBPASP,0)
  1. S ACG10=^ACGS(ACRBPASP,10)
  1. S ACGDT=^ACGS(ACRBPASP,"DT")
  1. S ACGDT1=^ACGS(ACRBPASP,"DT1")
  1. S ACGIHS=^ACGS(ACRBPASP,"IHS")
  1. S ACGSP=^ACGS(ACRBPASP,"SP")
  1. S ACGPARA=^ACGPARA(1,0)
  1. S ACG1DA=+ACGDT
  1. S (ACG1,ACGNC,ACGFLDS,ACGFLDSS)=$P(^ACGTPA(ACG1DA,0),U)
  1. S ACG5DA=$P(ACRDOCPO,U,5)
  1. S ACGFY=$P(ACGIHS,U,4)
  1. S ACG23=$P(^ACRDOC(ACRDOCDA,"PO"),U)
  1. S ACG25=$P(^ACRDOC(ACRDOCDA,"PO"),U,12)
  1. S ACG24=ACG23
  1. S ACG302=$O(^ACRSS("C",ACRDOCDA,0))
  1. I ACG302,$D(^ACRSS(ACG302,0)) S ACG302=$P(^(0),U,4)
  1. D NC1^ACGSNC
  1. W "..."
  1. S X=ACGSP
  1. S DA=ACGRDA
  1. S DIE="^ACGS("
  1. S DR="4////"_$P(ACGDT,U,4) ;ACR*2.1*3.27
  1. S DR=DR_";23////"_DT ;ACR*2.1*3.27
  1. S DR=DR_";24////"_$G(ACROD) ;BEGIN DATE ACR*2.1*3.27
  1. S DR=DR_";25////"_$G(ACRRQDD) ;END DATE ACR*2.1*3.27
  1. S DR=DR_";27////"_$P(ACGDT1,U,6) ;ACR*2.1*3.27
  1. S DR=DR_";301////"_$P(^ACRDOC(ACRDOCDA,0),U) ;ACR*2.1*3.27
  1. S DR=DR_";302////"_$P(X,U,2) ;ACR*2.1*3.27
  1. S DR=DR_";303////"_$P(X,U,3) ;ACR*2.1*3.27
  1. S DR=DR_";304////"_$P(X,U,4) ;ACR*2.1*3.27
  1. S DR=DR_";305////"_$P(X,U,5) ;ACR*2.1*3.27
  1. S DR=DR_";306////"_$P(X,U,6) ;ACR*2.1*3.27
  1. S DR=DR_";307////"_$P(X,U,7) ;ACR*2.1*3.27
  1. S DR=DR_";115////"_$P(ACGIHS,U,116) ;ACR*2.1*3.27
  1. D DIE^ACRFDIC
  1. S DA=ACRDOCDA
  1. S DIE="^ACRDOC("
  1. S DR=".16////"_ACGRDA
  1. D DIE^ACRFDIC
  1. D KILL^ACGSKILL
  1. K ACG0,ACG10,ACGDT,ACGDT1,ACGIHS,ACGSP,ACGPARA,ACG23,ACG24,ACG25,ACG302,ACG4
  1. Q
  1. EDIT S DA=ACRCISDA
  1. S DIE="^ACGS("
  1. S DR="[ACR SMALL PURCHASE DATA]"
  1. D DDS^ACRFDIC
  1. Q:'$D(ACRSCREN)
  1. K ACRSCREN
  1. S ACGRDA=ACRCISDA
  1. S ACG5DA=ACRVDA
  1. S ACGCNO=$P(^ACGS(ACGRDA,0),U,3)
  1. D CS^ACGSCS
  1. Q
  1. SYNC ;EP;TO ENSURE THAT CIS INFO STAYS IN SYNC WITH ARMS INFO
  1. Q:'$P(^ACRDOC(ACRDOCDA,0),U,16)
  1. S ACRCISDA=$P(^ACRDOC(ACRDOCDA,0),U,16)
  1. Q:'$D(^ACGS(ACRCISDA,0))
  1. S ACRVDA(1)=+$G(^ACGS(ACRCISDA,10))
  1. S ACRPOTOT(1)=$P($G(^ACGS(ACRCISDA,"DT1")),U,5)
  1. D ^ACRFSSPO
  1. S ACRVDA=$P(^ACRDOC(ACRDOCDA,"PO"),U,5)
  1. Q:ACRVDA=ACRVDA(1)&(ACRPOTOT=ACRPOTOT(1))
  1. S DA=ACRCISDA
  1. S DIE="^ACGS("
  1. S DR="1005////"_ACRVDA_";26////"_ACRPOTOT_";1099////"_DT
  1. D DIE^ACRFDIC
  1. I $P(^ACRDOC(ACRDOCDA,0),U,2)'=$P(^ACGS(ACRCISDA,"DT"),U,2) D
  1. .N ACRX,ACRY
  1. .S ACRX=$P(^ACRDOC(ACRDOCDA,0),U,2)
  1. .S ACRY=$P(^ACGS(ACRCISDA,"DT"),U,2)
  1. .I ACRX'=ACRY D
  1. ..S DA=ACRDOCDA
  1. ..S DIE="^ACRDOC("
  1. ..S DR="103020////"_ACRY
  1. ..D DIE^ACRFDIC
  1. .I +^ACGS(ACRCISDA,"DT")=15!(+^("DT")=17) D
  1. ..S DA=ACRCISDA
  1. ..S DIE="^ACGS("
  1. ..S DR="2////"_ACRX
  1. ..D DIE^ACRFDIC
  1. Q
  1. EINCHK ;CHECK FOR REQUIRED VENDOR DATA
  1. K ACRQUIT
  1. I '$D(^AUTTVNDR(ACG5DA))!($P($G(^AUTTVNDR(ACG5DA,11)),U,13)="") D
  1. .W !!,*7,*7,"Required VENDOR data is missing!!"
  1. .W !,"Use 11 - Add/Edit Vendor Data to enter REQUIRED Vendor data."
  1. .D PAUSE^ACRFWARN
  1. .S ACRQUIT=""
  1. Q
  1. VCHK ;CHECK TO ENSURE THAT VENDOR HAS BEEN SPECIFIED
  1. K ACRQUIT
  1. I 'ACG5DA D
  1. .W !!,*7,*7,"No VENDOR has been specified for this procurement."
  1. .W !,"Contract/Small Purchase data cannot be completed until a VENDOR is specifiec."
  1. .W !,"Complete BASIC DATA before proceeding."
  1. .D PAUSE^ACRFWARN
  1. .S ACRQUIT=""
  1. Q
  1. TPA ;SELECT TYPE OF PROCURMENT ACTION FOR CONTRACTS
  1. W !!,"Select the Type of Contract Action"
  1. S:'$P(^ACRDOC(ACRDOCDA,0),U,15) DIR(0)="SO^D:Definitive Contract;I:Indefinite Delivery Contract;L:Letter Contract",DIR("A")="Type Procurement Action..",ACGNEW=""
  1. S:$P(^ACRDOC(ACRDOCDA,0),U,15) 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. D DIR^ACRFDIC
  1. Q:$D(ACRQUIT)!($G(Y)="")
  1. S (ACG1,ACGNC,ACGFLDS,ACGFLDSS)=Y,ACG1DA=$S(Y="D":1,Y="I":2,Y="G":14,Y="N":16,Y="L":4,Y="P":15)
  1. Q