Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFACPS.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFACPS.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFACPS.m	(revision 636)
@@ -1,8 +1,8 @@
 PRCFACPS ;WISC@ALTOONA/CTB/DL-PURGE CODE SHEET CONTINUATION ;1/29/98 1300
-V ;;5.1;IFCAP;**114**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
 DQ ;;PURGE CODE SHEETS AND TRANSMISSION RECORDS
  D:$D(ZTQUEUED) KILL^%ZTLOAD
- S PRCFNAME=$S(PRCFASYS["CLMCLIRRLOG":"FEE/FEN, Receiving Reports & LOG",PRCFASYS["CLM":"FEE/FEN",PRCFASYS["ISM":"ISM",PRCFASYS["IRS":"IRS",1:"LOG")
+ S PRCFNAME=$S(PRCFASYS["CLM":"FEE/FEN",PRCFASYS["ISM":"ISM",PRCFASYS["IRS":"IRS",1:"LOG")
  L +^PRCF(423,0):5 I '$T S X="Code Sheet file unavailable - File lock timeout.*" D MSG^PRCFQ Q
  W:$D(IOF) @IOF W PRCFNAME_" CODE SHEET & TRANSMISSION RECORD DELETION TRANSCRIPT" D NOW^PRCFQ W ?IOM-$L(%X),%X
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFALOG.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFALOG.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFALOG.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCFALOG ;WISC/CTB-LOG CODE SHEETS ;11-27-92/08:20
-V ;;5.1;IFCAP;**114**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
 A S PRCHLOG="",PRCFASYS="LOGDLA" Q
 B K PRCHLOG,PRCFASYS Q
@@ -24,9 +24,4 @@
 PURGE ;PURGE CODE SHEETS
  D A S PRCFASYS=PRCFASYS_"PHA" D EN^PRCFACPR,B Q
-PURGE2 ;PURGE ALL CODE SHEETS
- W !!,"** YOU MUST SELECT A DESIGNATED PRINTER FOR PURGE TO FUNCTION PROPERLY."
- W !,"** DEFAULTING TO HOME DEVICE (0) WILL NOT PURGE DATA SINCE THE OPTION WILL BE "
- W !,"** TASKED.",!
- S PRCFASYS="CLMCLIRRLOGDLAPHAGSA" D EN^PRCFACPR,B Q
 ADD ;ADD CODE SHEET TO PRINTED BATCH
  D A,ADD^PRCFACR2,B Q
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHEF.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHEF.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHEF.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCHEF ;ID/RSD,SF-ISC/TKW-EDIT ROUTINES FOR SUPPLY SYSTEM ;6/10/97 9:34
-V ;;5.1;IFCAP;**107**;Oct 20, 2000;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
 EN80 ;DELETE A RECEIVING REPORT (CONT.FROM PRCHE)
@@ -7,5 +7,5 @@
  I $P($G(^PRC(442,PRCHPO,23)),U,11)="S"!($P($G(^(23)),U,11)="P") W !!,?5,"Please create an adjustment voucher to delete",!,?5,"receiving reports for purchase card orders.",! G EN80
  I $P($G(^PRC(442,PRCHPO,23)),U,11)="D" W !!,?5,"Please create an adjustment voucher to delete",!,?5,"receiving reports for delivery orders.",! G EN80
- I X<25!(X>33) W $C(7)," Receiving Report cannot be deleted, please create an adjustment voucher." G EN80
+ I X<25!(X>33) W $C(7)," ??" G EN80
  I '$O(^PRC(442,PRCHPO,11,0)) W !?3,"Order has no Receiving Reports !",$C(7) G EN80
  D LCK1^PRCHE G:'$D(DA) EN80 S:$P(^PRC(442,PRCHPO,0),U,2)=8 PRCHNRQ=1
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHMA.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHMA.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHMA.m	(revision 636)
@@ -1,18 +1,31 @@
 PRCHMA ;WISC/AKS-Amend to PO, req ;6/10/96  14:07
- ;;5.1;IFCAP;**21,79,100,113**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
-REQ N PRCHREQ
+ ;;5.1;IFCAP;**21,79,100**;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
+REQ ;Req.
+ N PRCHREQ
  S PRCHREQ=1
-PO N PRCF,RETURN,PRCHAM,PRCHPO,PRCHNEW,OUT,CAN,PRCHAU,PRCHER,PRCHON,A,B,ER,FL,FIS,DELIVER,PRCHAMDA,PRCHAV,PRCHL1,PRCHLN,PRCHRET,LCNT
- N PRCHL2,ROU,DIC,I,PRCHAMT,PRCHAREC,PRCHEDI,X,Y,PRCHN,PRCHO,SFUND,PRCHX,PRCHIMP,PRCHNRQ,PRCHP,REPO,PRCHNORE,%,%A,%B,D0,D1,J
+PO ;PO
+ N PRCF,RETURN,PRCHAM,PRCHPO,PRCHNEW,OUT,CAN,PRCHAU,PRCHER,PRCHON
+ N A,B,ER,FL,FIS,DELIVER,PRCHAMDA,PRCHAV,PRCHL1,PRCHLN,PRCHRET,LCNT
+ N PRCHL2,ROU,DIC,I,PRCHAMT,PRCHAREC,PRCHEDI,X,Y,PRCHN,PRCHO,SFUND
+ N PRCHX,PRCHIMP,PRCHNRQ,PRCHP,REPO,PRCHNORE,%,%A,%B,D0,D1,J
  N PRCFL,MSG
 LOOP D KILL^PRCHMA1 S PRCHNEW="",PRCHNORE=1,CAN=0
- ; See routine PRCHAMXA for information on variable PRCHNORE and undefined DIK, var PRCHPO is the basic premise of locks applied to amendments
+ ;
+ ; See routine PRCHAMXA for information on variable PRCHNORE and for
+ ; incidence of undefined DIK variable errors.
+ ; The var PRCHPO is the basic premise of locks applied to amendments.
+ ; Anytime amend module is accessed add +lock & save po# in PRCENTRY.
+ ;
  S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
- ; Lock simultaneous entry of users in amend. module for the same record.  Var Y is saved in PRCHPO at the end of GETPO subrtn, when we start
+ ;
+ ; Lock simultaneous entry of users in amend. module for the same record.
+ ; Var Y is saved in PRCHPO at the end of GETPO subrtn, when we start
  ; the process(AMENDNO) of amending the record we must have var PRCHPO.
+ ;
  S PRCFL=0
  W !! D GETPO^PRCHAMU
- ; If no record is selected or time-out or up-arrow out then exit without unlocking a record.
+ ; If no record is selected or time-out or up-arrow out then exit
+ ; without unlocking a record.
  I $D(DTOUT)!$D(DUOUT)!$G(OUT)=1 G EXIT1
  I PRCFL=1 G LOOP
@@ -33,21 +46,10 @@
  . I $G(PRCHAMDA)=31 D MSG^PRCHAMU Q
  . I $G(PRCHAMDA)=24,$G(X)=2 D MSG1^PRCHAMU S SCE=1 Q
+ ;
  I $P(^PRC(443.6,PRCHPO,6,PRCHAM,0),U,4)=5!($P(^(0),U,4)=15) S CAN=1
  I $D(DTOUT)!($D(DUOUT)) G EXIT
  I $G(NOCAN)=1 G ASK
  G:$P($G(^PRC(443.6,PRCHPO,6,PRCHAM,3,0)),U,4)'>1 EXIT
-CAN1 S BFLAG=0
- S:$P($G(^PRC(443.6,PRCHPO,1)),U,7)'=6 BFLAG=1
- I $P($G(^PRC(443.6,PRCHPO,1)),U,7)=6  D
- .S THISHLD=0
- .F  S THISHLD=$O(^PRC(443.6,PRCHPO,2,THISHLD)) Q:'THISHLD!(BFLAG=1)  D
- ..S:$P($G(^PRC(443.6,PRCHPO,2,THISHLD,2)),U,2)'="" BFLAG=1
- .Q:BFLAG=1
- .S THISHLD=0
- .F  S THISHLD=$O(^PRC(442,PRCHPO,2,THISHLD)) Q:'THISHLD!(BFLAG=1)  D
- ..S:$P($G(^PRC(442,PRCHPO,2,THISHLD,2)),U,2)'="" BFLAG=1
- W:BFLAG=0 !,"This is now a contract order.  You must add a contract to this orders item(s)",!,"before approving the amendment.",!
- G:BFLAG=0 EXIT
- D:BFLAG=1 UPDATE^PRCHAMU G:$D(Y) EXIT
+CAN1 D UPDATE^PRCHAMU G:$D(Y) EXIT
 CHK I '$$VERIFY^PRCHES5(PRCHPO) W !!,?5,"This purchase order has been tampered with.",!,?5,"Please notify IFCAP APPLICATION COORDINATOR." G EXIT
  I $P($G(^PRC(443.6,PRCHPO,6,PRCHAM,1)),U,4)']"" W !!,?5,"There is no Amendment Status." D
@@ -66,5 +68,6 @@
  ...S J=0 S J=$O(^PRC(443.6,PRCHPO,2,PRCH,1,J)) I J'>0 D:LCNT>END TOP W !!,?5,"Line item ",+$P(PRCHLN,U)," is missing its description!",$C(7) S PRCHER="",LCNT=LCNT+2
  ...I $P($G(^PRC(442,PRCHPO,23)),U,11)="D",$P($G(^PRC(443.6,PRCHPO,2,PRCH,2)),U,2)="" D:LCNT>END TOP W !!,?5,"Line item ",+$P(PRCHLN,U)," is missing contract number.",$C(7) S PRCHER="",LCNT=LCNT+2
- ...; PRC*5.1*79 - Check line items of PC orders with source code=6 to make sure that a contract number is entered
+ ...; PRC*5.1*79 - Check line items of PC orders with source code=6 to
+ ...; make sure that a contract number is entered
  ...D PCD^PRCHMA1
  ...Q
@@ -72,8 +75,13 @@
  .I $D(PRCHER) I LCNT>END N DIR S DIR(0)="E" D ^DIR S LCNT=1
  .Q
+ ;PRC*5.1*100: check line items without an FSC or PSC
  D EN106^PRCHNPO7 I $G(ERROR)=1 G EXIT
  I $P($G(^PRC(443.6,PRCHPO,0)),U,13)>0 I $P($G(^PRC(443.6,PRCHPO,23)),U)="" W !!,?5,"This amendment has Est. Shipping and/or Handling charges without any",!,?5,"Est. Shipping BOC." S PRCHER=""
  I $P($G(^PRC(443.6,PRCHPO,6,PRCHAM,0)),U,4)=5!($P($G(^(0)),U,4)=15) S CAN=1
  I $G(CAN)'=1 D CHECK^PRCHAMDF(PRCHPO,PRCHAM,.PRCHER)
+ ; 
+ ; Change below to allow checks for monthly limits in file #440.5 before
+ ; completion of the amendment.
+ ;
  I $G(PRCHAUTH)=1!($P($G(^PRC(443.6,PRCHPO,0)),U,2)=25) S FILE=443.6 D  I $G(ERROR) S PRCHER="" K ERROR,FILE
  .D ^PRCHSF3
@@ -107,7 +115,11 @@
  .D REMOVE^PRCSC2(PP410),ENCODE^PRCSC2(PP410,DUZ,.MESSAGE) K MESSAGE
  .I '$G(PRCPROST) W !?3,"SEND TO SUPPLY " S PRCHQ="^PRCHPAM",D0=PRCHPO,D1=PRCHAM D ^PRCHQUE
- .; Update file #440.5 after amendment has been approved. Consider orders created and amended in the same month and year and the user either
- .; cancels the order or enters other type of amendment that changes the final amount of the order. No credit is given for orders from a
+ .;
+ .; Update file #440.5 after amendment has been approved. Consider orders
+ .; created and amended in the same month and year and the user either
+ .; cancels the order or enters other type of amendment that changes the
+ .; final amount of the order. No credit is given for orders from a
  .; previous month and year. DT is the current date, system-supplied.
+ .;
  .S PRCHCD=$P($G(^PRC(442,PRCHPO,23)),U,8)
  .S PRCNODE=$G(^PRC(442,PRCHPO,6,0)),PRCAMD=$P(PRCNODE,U,3)
@@ -132,7 +144,10 @@
  S SFUND="" I $P($G(^PRC(443.6,PRCHPO,0)),U,19)=2 D SUPP^PRCFFM2M S SFUND=1
  I SFUND=1 W !?3,"SEND TO SUPPLY " S PRCHQ="^PRCHPAM",D0=PRCHPO,D1=PRCHAM D ^PRCHQUE
+ ;
  D SOURCE^PRCHAMU:$G(SCE)
  G EXIT
-ENC S ER=0
+ ;
+ENC ;Can
+ S ER=0
  D CAN^PRCHMA3
  I $G(NOCAN)=1 W !?5,$S($D(PRCHREQ):"REQUISITION",1:"PURCHASE ORDER")_" HAS BEEN RECEIVED, CANNOT CANCEL !",$C(7) S ER=1 Q
@@ -149,18 +164,24 @@
  S PRCHAMT=-$P(^PRC(443.6,PRCHPO,0),U,15) W !
  QUIT
-APP S %A="   Approve Amendment number "_PRCHAM_": ",%B="",%=$S($G(PRCPROST):1,1:2) D ^PRCFYN
+APP ;App,pr
+ S %A="   Approve Amendment number "_PRCHAM_": ",%B="",%=$S($G(PRCPROST):1,1:2) D ^PRCFYN
  Q
-REV N PRCH
+REV ;Rev
+ N PRCH
  S %=1,%B="",%A="   Review Amendment " D ^PRCHSF3 W ! D ^PRCFYN
  I %=1 S D0=PRCHPO,D1=PRCHAM,PRCH="^PRC(443.6," D ^PRCHDAM
  Q
-EXIT L -^PRC(442,PRCENTRY)
+EXIT ;Ex
+ L -^PRC(442,PRCENTRY)
 EXIT1 K ERROR,FIS,REPO,DEL
  QUIT:$G(PRCPROST)
  I $G(OUT)'=1 G LOOP
  QUIT
-FLAG I $G(FLAG)=1 K FLAG Q
+ ;
+FLAG ;
+ I $G(FLAG)=1 K FLAG Q
  Q
-NOSIGN S $P(^PRC(443.6,PRCHPO,6,PRCHAM,0),U,4)=PRCHAU
+NOSIGN ;
+ S $P(^PRC(443.6,PRCHPO,6,PRCHAM,0),U,4)=PRCHAU
 NOSIGN1 S DA(1)=PRCHPO,DIE="^PRC(443.6,"_DA(1)_",6,",DA=PRCHAM,DR="9///@"
  D ^DIE K DIE,DA,DR
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO3.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO3.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO3.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCHNPO3 ;WISC/RSD/RHD/SC-CONT. OF NEW PO ; 4/23/99 1:39pm
-V ;;5.1;IFCAP;*112*;Oct 20, 2000;Build 2
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
  S PRCHSZ=1
@@ -35,12 +35,8 @@
  D SPRMK^PRCHNPO6
  ;
-N Q:'PRCHSZ  K ^TMP($J,"PRCHS"),PRCHSIT S J=0,K=1,PRCHSIT(K)="" G:$D(PRCHPOST) 1
- W !?3,"Line Items: " R PRCHX:DTIME G Q:PRCHX["^"!(PRCHX=""),HLP:$E(PRCHX)="?",1:"Aa"[$E(PRCHX)
- F  Q:'$F(PRCHX,",,")  S PRCHX=$P(PRCHX,",,",1)_","_$P(PRCHX,",,",2,99) ; *112 remove consecutive commas
- S:$E(PRCHX)="," PRCHX=$E(PRCHX,2,$L(PRCHX)) ; *112 remove leading comma
- S:$E(PRCHX,$L(PRCHX))="," PRCHX=$E(PRCHX,1,$L(PRCHX)-1) ; *112 remove trailing comma
+N Q:'PRCHSZ  K ^TMP($J,"PRCHS"),PRCHSIT S J=0,K=1,PRCHSIT(K)="" G:$D(PRCHPOST) 1 W !?3,"Line Items: " R PRCHX:DTIME G Q:PRCHX["^"!(PRCHX=""),HLP:$E(PRCHX)="?",1:"Aa"[$E(PRCHX)
  F I=1:1 S X=$P(PRCHX,",",I) Q:X=""  I +X'=X S X(1)=$P(X,":",1),X(2)=$P(X,":",2) K:+X(1)'=X(1)!(+X(2)'=X(2))!'(X(1)<X(2)) PRCHX Q:'$D(PRCHX)  S $P(PRCHX,",",I)=X(1)_":1:"_X(2)
  I '$D(PRCHX) W " ??",$C(7) G N
- X "F I="_PRCHX_" D IT Q:'$O(^TMP($J,""PRCHS"",0))" G:'$O(^TMP($J,"PRCHS",0)) N S ^(0)=J
+ S:$E(PRCHX,$L(PRCHX))="," PRCHX=$E(PRCHX,1,$L(PRCHX)-1) X "F I="_PRCHX_" D IT Q:'$O(^TMP($J,""PRCHS"",0))" G:'$O(^TMP($J,"PRCHS",0)) N S ^(0)=J
  ;
 3 G 2:J=+^PRCS(410,PRCHSY,10),Q:'$O(^TMP($J,"PRCHS",0)) W !,"A new 2237 will now be created with the following items: " F K=0:0 S K=$O(PRCHSIT(K)) Q:'K  W !?3,PRCHSIT(K)
@@ -89,5 +85,5 @@
  Q
  ;
-VENMSG ;message to alert users that vendors don't match and that IMF will
+VENMSG ;mesasge to alert users that vendors don't match and that IMF will
  ;be updated.
  W !!,"NOTE-Vendors on PO and 2237 don't match.  If you proceed IMF info"," will be used.  If there is no IMF entry for the item for this vendor one will ","be created."
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO5.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO5.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO5.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCHNPO5 ;WISC/RSD,RHD/DL-INPUT TRANSFORM FOR FILE 440,441,442 ;9/5/00  10:59
-V ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
 EN1 ;FILE 442, FCP #1
@@ -17,5 +17,4 @@
  S PRC("APP")="",X=Z0,PRC("BBFY")=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),+X) I PRC("BBFY")="" Q
  S PRC("APP")=$P($$ACC^PRC0C(PRC("SITE"),+X_"^"_PRC("FY")_"^"_PRC("BBFY")),U,11) K Z0,Z1
- I $P($G(^PRC(420,PRC("SITE"),1,+X,0)),U,19)=1 W !,"Sorry, this FCP is inactive!",! K X Q
  Q
  ;
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO8.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO8.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO8.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCHNPO8 ;WISC/RHD/DL-MISCELLANEOUS ROUTINES FROM P.O.ADD/EDIT 443.6 ;9/5/00  12:30
-V ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
 EN1 ;FILE 443.6, FCP #1
@@ -15,5 +15,4 @@
  S PRC("APP")="",X=Z0,PRC("BBFY")=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),+X) I PRC("BBFY")="" Q
  S PRC("APP")=$P($$ACC^PRC0C(PRC("SITE"),+X_"^"_PRC("FY")_"^"_PRC("BBFY")),U,11) K Z0,Z1
- I $P($G(^PRC(420,PRC("SITE"),1,+X,0)),U,19)=1 W !,"Sorry, this FCP is inactive!",! K X Q
  Q
  ;
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHPCAR.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHPCAR.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHPCAR.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCHPCAR ;WISC/AKS-Front End questions for Purchase Card processes ;6/9/96  21:40
- ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
+ ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
 ASKPO ;Ask If they are processing a purchase or a requisition
  N DIR,Y,PRCHPR,PRCHNE
@@ -83,14 +83,2 @@
  K DA,%A,%B,%
  QUIT
-AOCANPC ;Approving Official Cancel a purchase card order
- N DIC,Y,NREC,X
- W ! S DIC="^PRC(442,",DIC(0)="AEQM"
- S DIC("A")="Select PURCHASE CARD ORDER NUMBER: "
- S DIC("S")="I $P($G(^(7)),U,2)<9,$P($G(^(0)),U,2)=25,($P($G(^(23)),U,11)=""P""!($P($G(^(23)),U,11)=""S""))"
- D ^DIC Q:+Y<0  K DIC
- S %A="Are sure you want to cancel this order",%B="",%=2
- D ^PRCFYN I %<1!(%=2) K %A,%B,% Q
- S DA=+Y,DIE="^PRC(442,",DR=".5///^S X=45" D ^DIE K DIE,DR
- D C2237^PRCH442A
- K DA,%A,%B,%
- QUIT
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQ4.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQ4.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQ4.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCHQ4 ;WOIFO/LKG-RFQ Set up Transmission Records ;7/25/05  15:27
- ;;5.1;IFCAP;**63,114**;Oct 20, 2000;Build 4
- ;Per VHA Directive 2004-038, this routine should not be modified.
+ ;;5.1;IFCAP;**63**;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
 HE ;Set up Heading segment
  N PRCN0,PRCN1,PRCA,PRCB,PRCZ,DA,DIC,DR,DIQ,X,Y
@@ -95,5 +95,5 @@
  . S PRCD=$G(^PRC(444,PRCDA,2,PRCA,1)),PRCG=$P(PRCB,U)
  . S PRCY="IT^"_PRCG_"^"_$S($P(PRCB,U,6)]"":$P(PRCB,U,6),$P(PRCB,U,5)>0:$P($G(^PRC(441.2,$P(PRCB,U,5),0)),U),1:"")_"^^^",PRCCNT=PRCCNT+1
- . I $P($G(^PRC(444,PRCDA,5,0)),U,4)=1,$P($G(^PRC(444,PRCDA,1)),U,8)'="y" S $P(PRCY,U,5)=$P($G(^PRC(444,PRCDA,2,PRCA,5)),U,2)
+ . I $P($G(^PRC(444,PRCDA,5,0)),U,4)=1,$P($G(^PRC(444,PRCDA,1)),U,8)'="y" S $P(PRCY,U,5)=$P($G(^PRC(444,PRCDA,5)),U,2)
  . S PRCY=PRCY_$P(PRCB,U,9)_"^"_$P(PRCB,U,8)_"^"_($P(PRCB,U,2)*100)_"^^"
  . S PRCE=$P(PRCB,U,3) S:PRCE?1.N PRCH=$P($G(^PRCD(420.5,PRCE,0)),U),$P(PRCY,U,9)=PRCH
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPLO2A.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPLO2A.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPLO2A.m	(revision 636)
@@ -1,7 +1,5 @@
 PRCPLO2A ;WOIFO/DAP-stock status report (cont) ; 1/26/06 12:00pm
-V ;;5.1;IFCAP;**83,98,112**;Oct 20, 2000;Build 2
+V ;;5.1;IFCAP;**83,98**;Oct 20, 2000;Build 37
  ;Per VHA Directive 2004-038, this routine should not be modified.
- ;External reference to $$GET1^DIQ(4, is supported by ICR# 10090
- ; *112 changes by: VMP, Holloway,T.
  ;
 ENT ;*83 Building ^TMP with total result data, totaling logic pulled from PRCPRSS0
@@ -105,11 +103,14 @@
  ;
  S %=($G(^TMP($J,1,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLOS:0,1:-%/TOTCLOS)
- S $P(^TMP($J,"PRCPSSR4",STA,INV),U,1)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ S $P(^TMP($J,"PRCPSSR4",STA,INV),U,1)=%
  ;Std. Turnover
  S %=($G(^TMP($J,2,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO1:0,1:-%/TOTCLO1)
- S $P(^TMP($J,"PRCPSSR4",STA,INV),U,2)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ S $P(^TMP($J,"PRCPSSR4",STA,INV),U,2)=%
  ;ODI Turnover
  S %=($G(^TMP($J,3,"ISS","TOTAL"))*365)/DAYS,%=$S('TOTCLO2:0,1:-%/TOTCLO2)
- S $P(^TMP($J,"PRCPSSR4",STA,INV),U,3)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ S $P(^TMP($J,"PRCPSSR4",STA,INV),U,3)=%
  ;All Turnover
  S $P(^TMP($J,"PRCPSSR4",STA,INV),U,4)=+$G(^TMP($J,1,"INACTN","TOTAL"))
@@ -127,14 +128,17 @@
  ;
  S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"INACT","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL")))
- I %="" S %=0
- S $P(^TMP($J,"PRCPSSR4",STA,INV),U,10)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ I %="" S %=0
+ S $P(^TMP($J,"PRCPSSR4",STA,INV),U,10)=%
  ;Std. Inactive %
  S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"INACT","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL")))
- I %="" S %=0
- S $P(^TMP($J,"PRCPSSR4",STA,INV),U,11)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ I %="" S %=0
+ S $P(^TMP($J,"PRCPSSR4",STA,INV),U,11)=%
  ;ODI Inactive %
  S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"INACT","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL")))
- I %="" S %=0
- S $P(^TMP($J,"PRCPSSR4",STA,INV),U,12)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ I %="" S %=0
+ S $P(^TMP($J,"PRCPSSR4",STA,INV),U,12)=%
  ;All Inactive %
  ;
@@ -158,14 +162,17 @@
  ;
  S %=$S('$G(^TMP($J,1,"VALUE","TOTAL")):0,1:$G(^TMP($J,1,"LONG","TOTAL"))/$G(^TMP($J,1,"VALUE","TOTAL")))
- I %="" S %=0
- S $P(^TMP($J,"PRCPSSR5",STA,INV),U,7)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ I %="" S %=0
+ S $P(^TMP($J,"PRCPSSR5",STA,INV),U,7)=%
  ;Std. Long Supply %
  S %=$S('$G(^TMP($J,2,"VALUE","TOTAL")):0,1:$G(^TMP($J,2,"LONG","TOTAL"))/$G(^TMP($J,2,"VALUE","TOTAL")))
- I %="" S %=0
- S $P(^TMP($J,"PRCPSSR5",STA,INV),U,8)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ I %="" S %=0
+ S $P(^TMP($J,"PRCPSSR5",STA,INV),U,8)=%
  ;ODI Long Supply %
  S %=$S('$G(^TMP($J,3,"VALUE","TOTAL")):0,1:$G(^TMP($J,3,"LONG","TOTAL"))/$G(^TMP($J,3,"VALUE","TOTAL")))
- I %="" S %=0
- S $P(^TMP($J,"PRCPSSR5",STA,INV),U,9)=$J(%,0,2)
+ I $P(%,".",2) S %=$P(%,".",1)_"."_$E($P(%,".",2),1,2)
+ I %="" S %=0
+ S $P(^TMP($J,"PRCPSSR5",STA,INV),U,9)=%
  ;All Long Supply %
  S $P(^TMP($J,"PRCPSSR5",STA,INV),U,10)=+$G(^TMP($J,1,"CNT","TOTAL"))
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUSEL.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUSEL.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUSEL.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCPUSEL ;WISC/RFJ/DAP-utilities: setup inventory variables ;14 Feb 91
-V ;;5.1;IFCAP;**1,83,110**;Oct 20, 2000;Build 7
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;**1,83**;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  ;  enter distribution point--input variables:
  ;  prcp("dptype")=distribution point type code [W,P,S]
@@ -20,5 +20,5 @@
  I % S PRCF("X")="S" D ^PRCFSITE I '+$G(PRC("SITE")) K PRC,PRCP Q
  ;
- S %=0 F I="DPTYPE","HIS","I","IN","INV" I '$G(PRCP(I)) S %=1 Q
+ S %=0 F I="DPTYPE","HIS","I","IN","INV" I '$D(PRCP(I)) S %=1 Q
  I '% D DISPLAY Q
  ;
@@ -101,5 +101,5 @@
  ;
  ;
-PARAM(INVPT) ;  set up parameters for inventory point
+PARAM(INVPT)       ;  set up parameters for inventory point
  K PRCP
  N DATA
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSD122.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSD122.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSD122.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCSD122 ;WISC/SAW-CONTROL POINT ACT. 2237 TERM. DISP. CON'T ;4/21/93  08:46
-V ;;5.1;IFCAP;**107**;Oct 20, 2000;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  I IOSL-$Y<5 D NEWP^PRCSD121 Q:Z1=U
  W !,"JUSTIFICATION OF NEED OR TURN-IN"
@@ -15,5 +15,5 @@
  W !,?37 K P1 S:$P(^PRCS(410,DA,7),U,3)'="" (P,P1)=$P(^(7),U,3) I $D(P1),$P(^(7),U,6)'="" W "/ES/",$$DECODE^PRCSC1(DA)
  N PRSHLB S PRSHLB=^DD(410,40,0) W ?69,! I $P(^PRCS(410,DA,7),U)'="" S (P,P2)=$P(^(7),U) I $P(PRSHLB,"^",2)[200,$D(^VA(200,P,20)),$P(^(20),U,2)]"" W $E($P(^(20),U,2),1,28)
- I $D(P2),$P(PRSHLB,"^",2)[200,$D(^VA(200,+P2,.13)),$L($P(^(.13),U,2))'>5 W " (",$P(^(.13),U,2),")"
+ I $D(P2),$P(PRSHLB,"^",2)[200,$D(^VA(200,+P2,.13)),$L($P(^(.13),U,2))'>4 W " (",$P(^(.13),U,2),")"
  N PRSHLC S PRSHLC=^DD(410,42,0) K P2 W ?37 I $D(P1),$P(PRSHLC,"^",2)[200,$D(^VA(200,P1,20)),$P(^(20),U,2)]"" W $E($P(^(20),U,2),1,30)
  W ?69,! W:$P(^PRCS(410,DA,7),U,2)'="" $P(^(7),U,2) W ?37 W:$P(^(7),U,4)'="" $P(^(7),U,4) W ?69 I $P(^(7),U,5)'="" S Y=$P(^(7),U,5) D DD^%DT W Y
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP122.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP122.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP122.m	(revision 636)
@@ -1,4 +1,4 @@
 PRCSP122 ;WISC/SAW-CONTROL POINT ACTIVITY 2237 PRINTOUT CON'T ;4/21/93  08:53
-V ;;5.1;IFCAP;**95,107**;Oct 20, 2000;Build 13
+V ;;5.1;IFCAP;**95**;Oct 20, 2000
  ;Per VHA Directive 2004-038, this routine should not be modified.
  I '$D(^PRCS(410,DA,"RM",0)) G DEL
@@ -24,5 +24,5 @@
  K P1 W !,?39,"|" S:$P(^PRCS(410,DA,7),U,3)'="" (P,P1)=$P(^(7),U,3) I $D(P1) W "/ES/",$$DECODE^PRCSC1(DA)
  N PRSHLE S PRSHLE=^DD(410,40,0) W ?72,"|",! I $P(^PRCS(410,DA,7),U)'="" S (P,P2)=$P(^(7),U) I $P(PRSHLE,"^",2)[200,$D(^VA(200,P,20)),$P(^(20),U,2)]"" W $E($P(^(20),U,2),1,31)
- I $D(P2),$P(^DD(410,40,0),"^",2)[200,$D(^VA(200,+P2,.13)),$L($P(^(.13),U,2))'>5 W " (",$P(^(.13),U,2),")"
+ I $D(P2),$P(^DD(410,40,0),"^",2)[200,$D(^VA(200,+P2,.13)),$L($P(^(.13),U,2))'>4 W " (",$P(^(.13),U,2),")"
  K P2 W ?39,"|" I $D(P1),$P(^DD(410,42,0),"^",2)[200,$D(^VA(200,P1,20)),$P(^(20),U,2)]"" W $E($P(^(20),U,2),1,33)
  W ?72,"|",! W:$P(^PRCS(410,DA,7),U,2)'="" $P(^(7),U,2) W ?39,"|" W:$P(^(7),U,4)'="" $P(^(7),U,4) W ?72,"|" S Y=$S($P(^(7),U,7):$P(^(7),U,7),1:$P(^(7),U,5)) I Y D DD^%DT W Y
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP1A.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP1A.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP1A.m	(revision 636)
@@ -1,4 +1,21 @@
 PRCSP1A ;WISC/SAW/BGJ-CONTROL POINT ACTIVITY PRINT OPTIONS CON'T ;5/1/92  9:20 AM [2/18/99 9:02am]
-V ;;5.1;IFCAP;**90**;Oct 20, 2000
+ ;;5.1;IFCAP;**90**;Oct 20, 2000;Build 4
+ ;Modified from FOIA VISTA,
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  ;Per VHA Directive 10-93-142, this routine should not be modified.
 CPB ;CP BAL
@@ -60,5 +77,5 @@
 HDR2 S P=P+1 W @IOF,"CONTROL POINT BALANCE - ",Z(0)_" "_$P(PRC("CP")," ",2),?50,TDATE,?73,"PAGE ",P,! Q
 HOLD G HDR:$E(IOST,1,2)'="C-"
-CRT W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U I ((Z1'=U)&&('$D(C1)))  D HDR
+CRT W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U I ((Z1'=U)&('$D(C1)))  D HDR
  Q
 CTR ;CEILING TRANS
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSRIG1.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSRIG1.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSRIG1.m	(revision 636)
@@ -1,5 +1,5 @@
 PRCSRIG1 ;WISC/SAW/KMB/LJP/SC-GENERATE REQUESTS FROM REPETITIVE ITEM LIST FILE (CON'T) ;3-3-93/14:30 ; 3/31/05 3:48pm
-V ;;5.1;IFCAP;**13,81,101,110**;Oct 20, 2000;Build 7
- ;Per VHA Directive 2004-038, this routine should not be modified.
+V ;;5.1;IFCAP;**13,81,101**;Oct 20, 2000
+ ;Per VHA Directive 10-93-142, this routine should not be modified.
  ;
  ;PRC*5.1*81, RIL that originated thru DynaMed is NOT allowed to be
@@ -33,4 +33,5 @@
 SV ;
  I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC
+ G EXIT:$D(ZTQUEUED)
  ;patch *81 -DynaMed trx. is not allowed to be re-used
  N PRCVSY,PRCVID
@@ -38,5 +39,4 @@
  I PRCVSY=1 S PRCVID=$$ITDMID(PRCSRID0)
  I PRCVSY=1,PRCVID=1 G CHK1
- G EXIT:$D(ZTQUEUED)
  U IO(0) S %=2 W !,"Do you wish to re-use this list " D YN^DICN G:%=1 JMP G:%=0 SV
 CHK1 I PRCSCT=PRCSCT(1) S DIK="^PRCS(410.3,",DA=PRCSRID0 D ^DIK G CLS
Index: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCST5.m
===================================================================
--- FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCST5.m	(revision 631)
+++ FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCST5.m	(revision 636)
@@ -1,3 +1,3 @@
-PRCST5 ; GENERATED FROM 'PRCS APPROVE REQUEST' PRINT TEMPLATE (#299) ; 11/15/05 ; (FILE 410, MARGIN=80)
+PRCST5 ; GENERATED FROM 'PRCS APPROVE REQUEST' PRINT TEMPLATE (#299) ; 04/11/06 ; (FILE 410, MARGIN=80)
  G BEGIN
 N W !
