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

PRCHFPD2.m

Go to the documentation of this file.
  1. PRCHFPD2 ;SF/FKV,TKW/RHD-PROMPT WHETHER FPDS DATA IS TO BE ENTERED ;2/9/93 14:54
  1. V ;;5.1;IFCAP;**79,100,220**;Oct 20, 2000;Build 23
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*220 Default 'Report to FPDS' to NO. Even a (Y)es
  1. ; will no longer send an FPDS message
  1. ;
  1. AMT ;
  1. 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)
  1. 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
  1. K PRCHI,PRCHY,DR
  1. Q
  1. CHEC ;
  1. I PRCHI=PRCHEC,PRCHEST'=(PRCHY*PRCHEC) S PRCHY=PRCHY+(PRCHEST-(PRCHY*PRCHEC))
  1. 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)
  1. S PRCH("AM",PRCH)=+$P(PRCH("AM",PRCH),U,2)
  1. Q
  1. FPDS ;
  1. ;If source code is not 2, 5, or [4,6,7,B], delivery order from a PA,
  1. ;do not ask for any FPDS information and quit.
  1. ;If source code is 9, do not ask for any FPDS information
  1. 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
  1. ;
  1. 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"
  1. S %B(3)="transactions,training authorizations,Government Bills of",%B(4)="Lading (GBL),and Government Transportation Requests (GTR)."
  1. S X="",PRCH="" F I=0:0 S PRCH=$O(PRCH("AM",PRCH)) Q:PRCH="" S X=X+$P(PRCH("AM",PRCH),U,2)
  1. ; 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.
  1. S X=X+PRCHEST,PRCHTTT=X
  1. ; For a delivery PO, forget the 25K limit on the total amount. This is
  1. ; intended for Purchasing Agents and Delivery Orders menu users. Now a
  1. ; definition for delivery orders is in effect: if the PO uses source
  1. ; codes 4, 6, 7, or B, then it is a delivery order (DO).
  1. ; Check Detailed PO from a PC user if it has source codes 6 or B.
  1. ; PRC*5.1*100: for non-general post funds (GPF), when creating a PO
  1. ; PRCHN("SFC")=0. If using a GPF, PRCHN("SFC")=1.
  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
  1. ;
  1. ; Check PO from users of the separate Delivery Orders menu
  1. I PRCHTTT>25000&(($G(PRCHPHAM)=1)!($G(PRCHDELV)=1))&($G(PRCHN("SFC"))>1!($G(PRCHN("SFC"))=0)) D PC Q
  1. ;
  1. ; Check PO from the purchasing agent who can use any source code.
  1. I PRCHTTT>25000&("467B"[PRCHSC)&($D(^PRC(442,PRCHPO,14)))&($G(PRCHN("SFC"))>1!($G(PRCHN("SFC"))=0)) D DEL Q
  1. ;
  1. S Y=$S(X>25000:0,"130"[PRCHSC:0,PRCHN("MP")=12:0,PRCHN("MP")=5:0,PRCHN("SFC")=1:0,1: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
  1. ; Check below for Delivery or Detailed purchase card orders, PRC*5.1*79
  1. I $G(PRCHTTT)'>0 S PRCHFPDS=0 Q ;don't need $0 orders
  1. I $G(PRCHPC)=2!$G(PRCHPHAM)=1!$G(PRCHDELV)=1 D PC Q
  1. ;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
  1. D AMT:$D(PRCHPO) ;PRC*5.1*220
  1. K %B
  1. Q
  1. ;
  1. 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. D AMT:$D(PRCHPO) ;PRC*5.1*220
  1. K %A,%B
  1. Q
  1. ;
  1. 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
  1. S A(1,"F")="!!?10"
  1. S A(2,"F")="!!"
  1. D EN^DDIOL(.A)
  1. S PRCHFPDS=1
  1. K A,%B
  1. Q