PRCHFPD2 ;SF/FKV,TKW/RHD-PROMPT WHETHER FPDS DATA IS TO BE ENTERED ;2/9/93 14:54
V ;;5.1;IFCAP;**79,100,220**;Oct 20, 2000;Build 23
;Per VA Directive 6402, this routine should not be modified.
;
;PRC*5.1*220 Default 'Report to FPDS' to NO. Even a (Y)es
; will no longer send an FPDS message
;
AMT ;
S PRCHY=0 I PRCHEST>0,PRCHEC>0 S PRCHY=PRCHEST/PRCHEC,Y=$P(PRCHY,".",2) I $L(Y)>2 S PRCHY=$P(PRCHY,".",1)+$J("."_Y,2,2)
S PRCH=0 F PRCHI=1:1 S PRCH=$O(PRCH("AM",PRCH)) Q:PRCH="" D CHEC S PRCHAMT=""""_PRCH("AM",PRCH)_"""" K DR S DR="35///"_PRCHAMT,DR(2,442.1)=".01////"_PRCHAMT S:PRCH'=".OM" DR(2,442.1)=DR(2,442.1)_";2////"_PRCH D ^DIE
K PRCHI,PRCHY,DR
Q
CHEC ;
I PRCHI=PRCHEC,PRCHEST'=(PRCHY*PRCHEC) S PRCHY=PRCHY+(PRCHEST-(PRCHY*PRCHEC))
I PRCHY>0 S PRCH("AM",PRCH)=$P(PRCH("AM",PRCH),U,1)_U_($P(PRCH("AM",PRCH),U,2)+PRCHY)_U_$P(PRCH("AM",PRCH),U,3)
S PRCH("AM",PRCH)=+$P(PRCH("AM",PRCH),U,2)
Q
FPDS ;
;If source code is not 2, 5, or [4,6,7,B], delivery order from a PA,
;do not ask for any FPDS information and quit.
;If source code is 9, do not ask for any FPDS information
I $D(^PRC(442,PRCHPO,14)),$P(^PRC(442,PRCHPO,23),U,11)'="P",$P(^PRC(442,PRCHPO,23),U,11)'="D",PRCHSC=9 S PRCHFPDS=0 D AMT Q
;
S PRCHFPDS=0,%B="Specifically excluded from reporting are grants,intragovernmental",%B(1)="procurements,procurements from imprest fund,nonappropriated",%B(2)="(general post,loan guarantee,etc.),SF44s,credit card"
S %B(3)="transactions,training authorizations,Government Bills of",%B(4)="Lading (GBL),and Government Transportation Requests (GTR)."
S X="",PRCH="" F I=0:0 S PRCH=$O(PRCH("AM",PRCH)) Q:PRCH="" S X=X+$P(PRCH("AM",PRCH),U,2)
; DON'T ASK FOR FPDS DATA IF TOTAL $>25,000, IF FEDERAL SOURCE, IF IMPREST FUNDS, IF A REQUISITION (FEDERAL SOURCE), OR IF GENERAL POST FUNDS.
S X=X+PRCHEST,PRCHTTT=X
; For a delivery PO, forget the 25K limit on the total amount. This is
; intended for Purchasing Agents and Delivery Orders menu users. Now a
; definition for delivery orders is in effect: if the PO uses source
; codes 4, 6, 7, or B, then it is a delivery order (DO).
; Check Detailed PO from a PC user if it has source codes 6 or B.
; PRC*5.1*100: for non-general post funds (GPF), when creating a PO
; PRCHN("SFC")=0. If using a GPF, PRCHN("SFC")=1.
I PRCHTTT>25000&($P(^PRC(442,PRCHPO,23),U,11)="P")&($G(PRCHPC)=2)&("6B"[PRCHSC)&($G(PRCHN("SFC"))>1!($G(PRCHN("SFC"))=0)) D PC Q
;
; Check PO from users of the separate Delivery Orders menu
I PRCHTTT>25000&(($G(PRCHPHAM)=1)!($G(PRCHDELV)=1))&($G(PRCHN("SFC"))>1!($G(PRCHN("SFC"))=0)) D PC Q
;
; Check PO from the purchasing agent who can use any source code.
I PRCHTTT>25000&("467B"[PRCHSC)&($D(^PRC(442,PRCHPO,14)))&($G(PRCHN("SFC"))>1!($G(PRCHN("SFC"))=0)) D DEL Q
;
S Y=$S(X>25000:0,"130"[PRCHSC:0,PRCHN("MP")=12:0,PRCHN("MP")=5:0,PRCHN("SFC")=1:0,1:1)
I 'Y S X=$S(X>25000:"Total Amount "_$J(X,11,2)_" is greater than $25000.00",1:"") W !!!,"No FPDS Data to be Entered: "_X,!!,%B,!,%B(1),!,%B(2),!,%B(3),!,%B(4),! D AMT K %B Q
; Check below for Delivery or Detailed purchase card orders, PRC*5.1*79
I $G(PRCHTTT)'>0 S PRCHFPDS=0 Q ;don't need $0 orders
I $G(PRCHPC)=2!$G(PRCHPHAM)=1!$G(PRCHDELV)=1 D PC Q
;S %A="Is this P.O. to be reported to the FPDS system (Under $25,000 report)",%=2 D YN^PRCFYN S:%=1 PRCHFPDS=1 K:%=-1 PRCHPO D AMT:$D(PRCHPO)&(%=2) ;PRC*5.1*220
D AMT:$D(PRCHPO) ;PRC*5.1*220
K %B
Q
;
DEL ;S %A="Is this P.O. to be reported to the FPDS system",%=2 W ! D YN^PRCFYN S:%=1 PRCHFPDS=1 K:%=-1 PRCHPO D AMT:$D(PRCHPO)&(%=2) ;PRC*5.1*220
D AMT:$D(PRCHPO) ;PRC*5.1*220
K %A,%B
Q
;
PC ; Checks below for PRC*5.1*79.
;S A(1)="This P.O. must be reported to the FPDS system." ;PRC*5.1*220
S A(1,"F")="!!?10"
S A(2,"F")="!!"
D EN^DDIOL(.A)
S PRCHFPDS=1
K A,%B
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHFPD2 3882 printed Oct 16, 2024@18:08:17 Page 2
PRCHFPD2 ;SF/FKV,TKW/RHD-PROMPT WHETHER FPDS DATA IS TO BE ENTERED ;2/9/93 14:54
V ;;5.1;IFCAP;**79,100,220**;Oct 20, 2000;Build 23
+1 ;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;PRC*5.1*220 Default 'Report to FPDS' to NO. Even a (Y)es
+4 ; will no longer send an FPDS message
+5 ;
AMT ;
+1 SET PRCHY=0
IF PRCHEST>0
IF PRCHEC>0
SET PRCHY=PRCHEST/PRCHEC
SET Y=$PIECE(PRCHY,".",2)
IF $LENGTH(Y)>2
SET PRCHY=$PIECE(PRCHY,".",1)+$JUSTIFY("."_Y,2,2)
+2 SET PRCH=0
FOR PRCHI=1:1
SET PRCH=$ORDER(PRCH("AM",PRCH))
if PRCH=""
QUIT
DO CHEC
SET PRCHAMT=""""_PRCH("AM",PRCH)_""""
KILL DR
SET DR="35///"_PRCHAMT
SET DR(2,442.1)=".01////"_PRCHAMT
if PRCH'=".OM"
SET DR(2,442.1)=DR(2,442.1)_";2////"_PRCH
DO ^DIE
+3 KILL PRCHI,PRCHY,DR
+4 QUIT
CHEC ;
+1 IF PRCHI=PRCHEC
IF PRCHEST'=(PRCHY*PRCHEC)
SET PRCHY=PRCHY+(PRCHEST-(PRCHY*PRCHEC))
+2 IF PRCHY>0
SET PRCH("AM",PRCH)=$PIECE(PRCH("AM",PRCH),U,1)_U_($PIECE(PRCH("AM",PRCH),U,2)+PRCHY)_U_$PIECE(PRCH("AM",PRCH),U,3)
+3 SET PRCH("AM",PRCH)=+$PIECE(PRCH("AM",PRCH),U,2)
+4 QUIT
FPDS ;
+1 ;If source code is not 2, 5, or [4,6,7,B], delivery order from a PA,
+2 ;do not ask for any FPDS information and quit.
+3 ;If source code is 9, do not ask for any FPDS information
+4 IF $DATA(^PRC(442,PRCHPO,14))
IF $PIECE(^PRC(442,PRCHPO,23),U,11)'="P"
IF $PIECE(^PRC(442,PRCHPO,23),U,11)'="D"
IF PRCHSC=9
SET PRCHFPDS=0
DO AMT
QUIT
+5 ;
+6 SET PRCHFPDS=0
SET %B="Specifically excluded from reporting are grants,intragovernmental"
SET %B(1)="procurements,procurements from imprest fund,nonappropriated"
SET %B(2)="(general post,loan guarantee,etc.),SF44s,credit card"
+7 SET %B(3)="transactions,training authorizations,Government Bills of"
SET %B(4)="Lading (GBL),and Government Transportation Requests (GTR)."
+8 SET X=""
SET PRCH=""
FOR I=0:0
SET PRCH=$ORDER(PRCH("AM",PRCH))
if PRCH=""
QUIT
SET X=X+$PIECE(PRCH("AM",PRCH),U,2)
+9 ; DON'T ASK FOR FPDS DATA IF TOTAL $>25,000, IF FEDERAL SOURCE, IF IMPREST FUNDS, IF A REQUISITION (FEDERAL SOURCE), OR IF GENERAL POST FUNDS.
+10 SET X=X+PRCHEST
SET PRCHTTT=X
+11 ; For a delivery PO, forget the 25K limit on the total amount. This is
+12 ; intended for Purchasing Agents and Delivery Orders menu users. Now a
+13 ; definition for delivery orders is in effect: if the PO uses source
+14 ; codes 4, 6, 7, or B, then it is a delivery order (DO).
+15 ; Check Detailed PO from a PC user if it has source codes 6 or B.
+16 ; PRC*5.1*100: for non-general post funds (GPF), when creating a PO
+17 ; PRCHN("SFC")=0. If using a GPF, PRCHN("SFC")=1.
+18 IF PRCHTTT>25000&($PIECE(^PRC(442,PRCHPO,23),U,11)="P")&($GET(PRCHPC)=2)&("6B"[PRCHSC)&($GET(PRCHN("SFC"))>1!($GET(PRCHN("SFC"))=0))
DO PC
QUIT
+19 ;
+20 ; Check PO from users of the separate Delivery Orders menu
+21 IF PRCHTTT>25000&(($GET(PRCHPHAM)=1)!($GET(PRCHDELV)=1))&($GET(PRCHN("SFC"))>1!($GET(PRCHN("SFC"))=0))
DO PC
QUIT
+22 ;
+23 ; Check PO from the purchasing agent who can use any source code.
+24 IF PRCHTTT>25000&("467B"[PRCHSC)&($DATA(^PRC(442,PRCHPO,14)))&($GET(PRCHN("SFC"))>1!($GET(PRCHN("SFC"))=0))
DO DEL
QUIT
+25 ;
+26 SET Y=$SELECT(X>25000:0,"130"[PRCHSC:0,PRCHN("MP")=12:0,PRCHN("MP")=5:0,PRCHN("SFC")=1:0,1:1)
+27 IF 'Y
SET X=$SELECT(X>25000:"Total Amount "_$JUSTIFY(X,11,2)_" is greater than $25000.00",1:"")
WRITE !!!,"No FPDS Data to be Entered: "_X,!!,%B,!,%B(1),!,%B(2),!,%B(3),!,%B(4),!
DO AMT
KILL %B
QUIT
+28 ; Check below for Delivery or Detailed purchase card orders, PRC*5.1*79
+29 ;don't need $0 orders
IF $GET(PRCHTTT)'>0
SET PRCHFPDS=0
QUIT
+30 IF $GET(PRCHPC)=2!$GET(PRCHPHAM)=1!$GET(PRCHDELV)=1
DO PC
QUIT
+31 ;S %A="Is this P.O. to be reported to the FPDS system (Under $25,000 report)",%=2 D YN^PRCFYN S:%=1 PRCHFPDS=1 K:%=-1 PRCHPO D AMT:$D(PRCHPO)&(%=2) ;PRC*5.1*220
+32 ;PRC*5.1*220
if $DATA(PRCHPO)
DO AMT
+33 KILL %B
+34 QUIT
+35 ;
DEL ;S %A="Is this P.O. to be reported to the FPDS system",%=2 W ! D YN^PRCFYN S:%=1 PRCHFPDS=1 K:%=-1 PRCHPO D AMT:$D(PRCHPO)&(%=2) ;PRC*5.1*220
+1 ;PRC*5.1*220
if $DATA(PRCHPO)
DO AMT
+2 KILL %A,%B
+3 QUIT
+4 ;
PC ; Checks below for PRC*5.1*79.
+1 ;S A(1)="This P.O. must be reported to the FPDS system." ;PRC*5.1*220
+2 SET A(1,"F")="!!?10"
+3 SET A(2,"F")="!!"
+4 DO EN^DDIOL(.A)
+5 SET PRCHFPDS=1
+6 KILL A,%B
+7 QUIT
