- 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 Jan 18, 2025@03:08:44 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