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