- 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