- PRCHPAM8 ;ID/TKW,RSD/RHD-PRINT AMENDMENT ;6/9/99 10:48
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, 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(443.6,D0,6,D1)) S PRCH0=$G(^(D1,0)),PRCH1=$G(^(1)),PRCHAV=$S($P(PRCH0,U,8)="Y":1,1:0),PRCHP0=^PRC(443.6,D0,0),PRCHP1=$G(^(1)),PRC("SITE")=$P(+PRCHP0,"-",1),PRCHUL="",$P(PRCHUL,"_",98)=""
- S SITE=$P($G(^PRC(443.6,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(443.6,D0,6,D1,2,0)),U,4)'>0 D START^PRCHPAM2(D0,D1) G CONT
- F PRCHJJ=0:0 S P=$O(^PRC(443.6,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^PRCHPAM9
- D HDR^PRCHPAM9 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,19)
- 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,57),!,"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,40),! 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,40),!
- 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,40),!,$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 speci-",!,"fied 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 ^PRCHPAM9
- ;
- 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[HPRCHPAM8 4082 printed Feb 18, 2025@23:35:43 Page 2
- PRCHPAM8 ;ID/TKW,RSD/RHD-PRINT AMENDMENT ;6/9/99 10:48
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, 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(443.6,D0,6,D1))
- QUIT
- SET PRCH0=$GET(^(D1,0))
- SET PRCH1=$GET(^(1))
- SET PRCHAV=$SELECT($PIECE(PRCH0,U,8)="Y":1,1:0)
- SET PRCHP0=^PRC(443.6,D0,0)
- SET PRCHP1=$GET(^(1))
- SET PRC("SITE")=$PIECE(+PRCHP0,"-",1)
- SET PRCHUL=""
- SET $PIECE(PRCHUL,"_",98)=""
- +6 SET SITE=$PIECE($GET(^PRC(443.6,D0,23)),U,7)
- SET SITE=$SELECT($GET(SITE)]"":SITE,1:PRC("SITE"))
- +7 SET PRCHPG=1
- SET PRCHPGT=2
- +8 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(443.6,D0,6,D1,2,0)),U,4)'>0
- DO START^PRCHPAM2(D0,D1)
- GOTO CONT
- +9 FOR PRCHJJ=0:0
- SET P=$ORDER(^PRC(443.6,D0,6,D1,2,P))
- if P=""!(P'>0)
- QUIT
- SET X=^(P,0)
- DO DIWP^PRCUTL($GET(DA))
- +10 KILL PRCHJJ
- SET %X="^UTILITY($J,""W"",DIWL,"
- SET %Y="^TMP($J,""AMD"",DIWL,"
- DO %XY^%RCR
- SET PRCHPG=1
- SET PRCHPGT=2
- +11 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
- +12 if +^UTILITY($JOB,"W",DIWL)>37
- SET PRCHPGT=PRCHPGT+1
- CONT if PRCHAV
- GOTO EN2^PRCHPAM9
- +1 DO HDR^PRCHPAM9
- 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,19)
- +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,57),!,"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,40),!
- 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,40),!
- +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,40),!,$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 speci-",!,"fied 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 ^PRCHPAM9
- +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
