PRCHPAM ;WISC/AKS,ID/TKW/RSD/RHD-PRINT AMENDMENT ;4/22/99 15:39
V ;;5.1;IFCAP;**132**;Oct 20, 2000;Build 3
;Per VHA Directive 2004-038, this routine should not be modified.
;
N SITE
S D0=$S($D(PRCHPO):PRCHPO,1:D0),D1=$S($D(PRCHAM):PRCHAM,1:D1)
S U="^" Q:'$D(^PRC(442,D0,6,D1)) S PRCH0=$G(^(D1,0)) Q:PRCH0=""
S PRCH1=$G(^(1)) Q:PRCH1=""
S PRCHAV=$S($P(PRCH0,U,8)="Y":1,1:0),PRCHP0=$G(^PRC(442,D0,0)) Q:PRCHP0=""
S PRCHP1=$G(^(1)) Q:PRCHP1=""
S PRC("SITE")=$P(+PRCHP0,"-",1),PRCHUL="",$P(PRCHUL,"_",96)=""
S SITE=$P($G(^PRC(442,D0,23)),U,7),SITE=$S($G(SITE)]"":SITE,1:PRC("SITE"))
S PRCHPG=1,PRCHPGT=2
K ^UTILITY($J,"W"),^TMP($J,"AMD") S DIWL=1,DIWR=91,DIWF="",P=0 I PRCHAV'>0,$P($G(^PRC(442,D0,6,D1,2,0)),U,4)'>0 D START^PRCHDSP4(D0,D1) G CONT
F PRCHJJ=0:0 S P=$O(^PRC(442,D0,6,D1,2,P)) Q:P=""!(P'>0) S X=^(P,0) D DIWP^PRCUTL($G(DA))
K PRCHJJ S %X="^UTILITY($J,""W"",DIWL,",%Y="^TMP($J,""AMD"",DIWL," D %XY^%RCR S PRCHPG=1,PRCHPGT=2
S X=+^UTILITY($J,"W",DIWL) I X>37 S X=X-52 F I=0:0 Q:X'>41 S X=X-56,PRCHPGT=PRCHPGT+1
S:+^UTILITY($J,"W",DIWL)>37 PRCHPGT=PRCHPGT+1
CONT G:PRCHAV EN2^PRCHPAM1
D HDR^PRCHPAM1 W "2.AMENDMENT/MODIFICATION NO. ",?29,"|3.EFFECTIVE DATE",?46,"|4.REQUISITION/PURCHASE REQ.NO.",?77,"|5.PROJECT NO."
W !?7,$P(PRCH0,U,1),?29,"| " S Y=$P(PRCH0,U,2) D DT S Y=0 I $P(PRCHP0,U,12),$D(^PRCS(410,+$P(PRCHP0,U,12),0)) S Y=$P(^(0),U,1)
W ?46,"| ",$S(Y:Y_"/",1:" "),$P($P(PRCHP0,U,1),"-",2),?77,"| (If applicable)",!,?29,"|",?46,"|",?77,"|"
W !,$E(PRCHUL,1,29),"|",$E(PRCHUL,1,16),"|",$E(PRCHUL,1,30),"|",$E(PRCHUL,1,18)
W !,"6.ISSUED BY ",?26,"CODE|________| 7.ADMINISTERED BY (If other than item 6) CODE|_______" S Y=$G(^PRC(411,SITE,3))
W !?3,"A&MM SERVICE",?39,"|",!?3,"VA MEDICAL CENTER",?39,"|",! F I=1:1:2 W:$P(Y,U,I)]"" ?3,$P(Y,U,I),?39,"|",!?3
W $P(Y,U,3),", ",$P($G(^DIC(5,+$P(Y,U,4),0)),U,2)," ",$P(Y,U,5),?39,"|" F I=1:1:2-I W !?39,"|"
S X=$G(^PRC(440,+PRCHP1,0)) W !,$E(PRCHUL,1,39),"|",$E(PRCHUL,1,56),!,"8.NAME & ADDRESS OF CONTRACTOR (No.,street,county,",?52,"| | 9A.AMENDMENT OF SOLICITATION NO.",!
W ?31,"State and ZIP Code)",?52,"| |",!,?13,$P(X,U,1),?52,"| |",$E(PRCHUL,1,39),! S J=1 D AL
W ?52,"| | 9B.DATED (See Item 11)",! D:J'>5 AL W ?52,"| |",! D:J'>5 AL W ?52,"|___|",$E(PRCHUL,1,39),!
D:J'>5 AL W ?52,"| | 10A.MODIFICATION OF CONTRACT/ORDER NO.",! D:J'>5 AL W ?52,"| X |",?61,$P(PRCHP0,U,1),!
S PRCVFAX=$P($G(^PRC(440,+PRCHP1,10)),U,6) W:PRCVFAX'="" ?13,"FAX: ",PRCVFAX K PRCVFAX
W ?52,"| |",$E(PRCHUL,1,39),!,$E(PRCHUL,1,52),?52,"| | 10B.DATED (See Item 13)",!,"CODE",?30,"|FACILITY CODE",?52,"| |",?61 S Y=$P(PRCHP1,U,15) D DT
W !,$E(PRCHUL,1,30),"|",$E(PRCHUL,1,21),"|___|",$E(PRCHUL,1,38),!,?16,"11.THIS ITEM ONLY APPLIES TO AMENDMENTS OF SOLICITATIONS",!,PRCHUL,!
W !,"____ The above numbered solicitation is amended as set forth in Item 14. The hour and date ",!,"specified for receipt of offers ____is extended ____is not extended.",!
W "Offers must acknowledge receipt of this amendment prior to the hour and date specified in the",!,"solicitation or as amended by one of the following methods:",!!
W "(a) By completing Items 8 and 15 and returning ______ copies of the amendment:",!,"(b) By acknowledging receipt of this amendment on each copy of the offer submitted: or",!
W "(c) By separate letter or telegram which includes a reference to the solicitation and amendment",!,"numbers. FAILURE OF YOUR ACKNOWLEDGEMENT TO BE RECEIVED AT THE PLACE DESIGNATED FOR THE RECEIPT",!
W "OF OFFERS PRIOR TO THE HOUR AND DATE SPECIFIED MAY RESULT IN REJECTION OF YOUR OFFER. If by vir-",!,"tue of this amendment you desire to change an offer already submitted, such change may be made",!
W "by telegram or letter, provided each telegram or letter makes reference to the solicitation and",!,"this amendment, and is received prior to the opening hour and date specified.",!
G ^PRCHPAM1
;
DT Q:'Y W Y\100#100,"/",Y#100\1,"/",Y\10000+1700
Q
;
AL F I=J:1 S J=J+1 Q:J>6 I $P(X,U,J)]"" G:J=6 AL1 W ?13,$P(X,U,J) Q
Q
;
AL1 W ?13,$P(X,U,6),", ",$P($G(^DIC(5,+$P(X,U,7),0)),U,2)," ",$P(X,U,8)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHPAM 4159 printed Sep 23, 2025@19:45:17 Page 2
PRCHPAM ;WISC/AKS,ID/TKW/RSD/RHD-PRINT AMENDMENT ;4/22/99 15:39
V ;;5.1;IFCAP;**132**;Oct 20, 2000;Build 3
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;
+3 NEW SITE
+4 SET D0=$SELECT($DATA(PRCHPO):PRCHPO,1:D0)
SET D1=$SELECT($DATA(PRCHAM):PRCHAM,1:D1)
+5 SET U="^"
if '$DATA(^PRC(442,D0,6,D1))
QUIT
SET PRCH0=$GET(^(D1,0))
if PRCH0=""
QUIT
+6 SET PRCH1=$GET(^(1))
if PRCH1=""
QUIT
+7 SET PRCHAV=$SELECT($PIECE(PRCH0,U,8)="Y":1,1:0)
SET PRCHP0=$GET(^PRC(442,D0,0))
if PRCHP0=""
QUIT
+8 SET PRCHP1=$GET(^(1))
if PRCHP1=""
QUIT
+9 SET PRC("SITE")=$PIECE(+PRCHP0,"-",1)
SET PRCHUL=""
SET $PIECE(PRCHUL,"_",96)=""
+10 SET SITE=$PIECE($GET(^PRC(442,D0,23)),U,7)
SET SITE=$SELECT($GET(SITE)]"":SITE,1:PRC("SITE"))
+11 SET PRCHPG=1
SET PRCHPGT=2
+12 KILL ^UTILITY($JOB,"W"),^TMP($JOB,"AMD")
SET DIWL=1
SET DIWR=91
SET DIWF=""
SET P=0
IF PRCHAV'>0
IF $PIECE($GET(^PRC(442,D0,6,D1,2,0)),U,4)'>0
DO START^PRCHDSP4(D0,D1)
GOTO CONT
+13 FOR PRCHJJ=0:0
SET P=$ORDER(^PRC(442,D0,6,D1,2,P))
if P=""!(P'>0)
QUIT
SET X=^(P,0)
DO DIWP^PRCUTL($GET(DA))
+14 KILL PRCHJJ
SET %X="^UTILITY($J,""W"",DIWL,"
SET %Y="^TMP($J,""AMD"",DIWL,"
DO %XY^%RCR
SET PRCHPG=1
SET PRCHPGT=2
+15 SET X=+^UTILITY($JOB,"W",DIWL)
IF X>37
SET X=X-52
FOR I=0:0
if X'>41
QUIT
SET X=X-56
SET PRCHPGT=PRCHPGT+1
+16 if +^UTILITY($JOB,"W",DIWL)>37
SET PRCHPGT=PRCHPGT+1
CONT if PRCHAV
GOTO EN2^PRCHPAM1
+1 DO HDR^PRCHPAM1
WRITE "2.AMENDMENT/MODIFICATION NO. ",?29,"|3.EFFECTIVE DATE",?46,"|4.REQUISITION/PURCHASE REQ.NO.",?77,"|5.PROJECT NO."
+2 WRITE !?7,$PIECE(PRCH0,U,1),?29,"| "
SET Y=$PIECE(PRCH0,U,2)
DO DT
SET Y=0
IF $PIECE(PRCHP0,U,12)
IF $DATA(^PRCS(410,+$PIECE(PRCHP0,U,12),0))
SET Y=$PIECE(^(0),U,1)
+3 WRITE ?46,"| ",$SELECT(Y:Y_"/",1:" "),$PIECE($PIECE(PRCHP0,U,1),"-",2),?77,"| (If applicable)",!,?29,"|",?46,"|",?77,"|"
+4 WRITE !,$EXTRACT(PRCHUL,1,29),"|",$EXTRACT(PRCHUL,1,16),"|",$EXTRACT(PRCHUL,1,30),"|",$EXTRACT(PRCHUL,1,18)
+5 WRITE !,"6.ISSUED BY ",?26,"CODE|________| 7.ADMINISTERED BY (If other than item 6) CODE|_______"
SET Y=$GET(^PRC(411,SITE,3))
+6 WRITE !?3,"A&MM SERVICE",?39,"|",!?3,"VA MEDICAL CENTER",?39,"|",!
FOR I=1:1:2
if $PIECE(Y,U,I)]""
WRITE ?3,$PIECE(Y,U,I),?39,"|",!?3
+7 WRITE $PIECE(Y,U,3),", ",$PIECE($GET(^DIC(5,+$PIECE(Y,U,4),0)),U,2)," ",$PIECE(Y,U,5),?39,"|"
FOR I=1:1:2-I
WRITE !?39,"|"
+8 SET X=$GET(^PRC(440,+PRCHP1,0))
WRITE !,$EXTRACT(PRCHUL,1,39),"|",$EXTRACT(PRCHUL,1,56),!,"8.NAME & ADDRESS OF CONTRACTOR (No.,street,county,",?52,"| | 9A.AMENDMENT OF SOLICITATION NO.",!
+9 WRITE ?31,"State and ZIP Code)",?52,"| |",!,?13,$PIECE(X,U,1),?52,"| |",$EXTRACT(PRCHUL,1,39),!
SET J=1
DO AL
+10 WRITE ?52,"| | 9B.DATED (See Item 11)",!
if J'>5
DO AL
WRITE ?52,"| |",!
if J'>5
DO AL
WRITE ?52,"|___|",$EXTRACT(PRCHUL,1,39),!
+11 if J'>5
DO AL
WRITE ?52,"| | 10A.MODIFICATION OF CONTRACT/ORDER NO.",!
if J'>5
DO AL
WRITE ?52,"| X |",?61,$PIECE(PRCHP0,U,1),!
+12 SET PRCVFAX=$PIECE($GET(^PRC(440,+PRCHP1,10)),U,6)
if PRCVFAX'=""
WRITE ?13,"FAX: ",PRCVFAX
KILL PRCVFAX
+13 WRITE ?52,"| |",$EXTRACT(PRCHUL,1,39),!,$EXTRACT(PRCHUL,1,52),?52,"| | 10B.DATED (See Item 13)",!,"CODE",?30,"|FACILITY CODE",?52,"| |",?61
SET Y=$PIECE(PRCHP1,U,15)
DO DT
+14 WRITE !,$EXTRACT(PRCHUL,1,30),"|",$EXTRACT(PRCHUL,1,21),"|___|",$EXTRACT(PRCHUL,1,38),!,?16,"11.THIS ITEM ONLY APPLIES TO AMENDMENTS OF SOLICITATIONS",!,PRCHUL,!
+15 WRITE !,"____ The above numbered solicitation is amended as set forth in Item 14. The hour and date ",!,"specified for receipt of offers ____is extended ____is not extended.",!
+16 WRITE "Offers must acknowledge receipt of this amendment prior to the hour and date specified in the",!,"solicitation or as amended by one of the following methods:",!!
+17 WRITE "(a) By completing Items 8 and 15 and returning ______ copies of the amendment:",!,"(b) By acknowledging receipt of this amendment on each copy of the offer submitted: or",!
+18 WRITE "(c) By separate letter or telegram which includes a reference to the solicitation and amendment",!,"numbers. FAILURE OF YOUR ACKNOWLEDGEMENT TO BE RECEIVED AT THE PLACE DESIGNATED FOR THE RECEIPT",!
+19 WRITE "OF OFFERS PRIOR TO THE HOUR AND DATE SPECIFIED MAY RESULT IN REJECTION OF YOUR OFFER. If by vir-",!,"tue of this amendment you desire to change an offer already submitted, such change may be made",!
+20 WRITE "by telegram or letter, provided each telegram or letter makes reference to the solicitation and",!,"this amendment, and is received prior to the opening hour and date specified.",!
+21 GOTO ^PRCHPAM1
+22 ;
DT if 'Y
QUIT
WRITE Y\100#100,"/",Y#100\1,"/",Y\10000+1700
+1 QUIT
+2 ;
AL FOR I=J:1
SET J=J+1
if J>6
QUIT
IF $PIECE(X,U,J)]""
if J=6
GOTO AL1
WRITE ?13,$PIECE(X,U,J)
QUIT
+1 QUIT
+2 ;
AL1 WRITE ?13,$PIECE(X,U,6),", ",$PIECE($GET(^DIC(5,+$PIECE(X,U,7),0)),U,2)," ",$PIECE(X,U,8)
+1 QUIT
