source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHEB.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1PRCHEB ;ID/RSD,SF-ISC/TKW-EDIT ROUTINES FOR SUPPLY SYSTEM ;11-20-92/12:01
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ;CANCEL UNOBLIGATED REQUISITION
5 S PRCHNRQ=1 D EN7^PRCHEA K PRCHNRQ
6 Q
7 ;
8EN0 ;REMOVE 2237 FROM REQUISITION
9 S PRCHNRQ=1 D ^PRCHE2 K PRCHNRQ
10 Q
11 ;
12EN1 ;AMENDMENT TO REQUISITION
13 S PRCHNRQ=1 D EN6^PRCHEA K PRCHNRQ
14 Q
15 ;
16EN2 ;ADJUSTMENT VOUCHER TO RECV.REPORT FOR REQUISITION
17 S (PRCHREQ,PRCHNRQ)=1 D EN14^PRCHE K PRCHNRQ
18 Q
19 ;
20EN3 ; CREATE A NEW IMPREST FUND P.O.
21 D ST Q:'$D(PRC("SITE"))
22EN30 S PRCHP("A")="IMPREST FUND P.O.NO.: ",PRCHP("T")=7,PRCHP("S")=3 D EN^PRCHPAT Q:'$D(PRCHPO) D LCK1 G:'$D(DA) EN30 S X=1 D ENS^PRCHSTAT,^PRCHNPO L
23 G EN30
24 ;
25EN4 ;EDIT AN IMPREST FUND P.O.
26 D ST Q:'$D(PRC("SITE"))
27 ;
28EN40 S PRCHP("A")="IMPREST FUND P.O.NO.: ",PRCHP("S")="$P(^(0),U,2)=7" D EN3^PRCHPAT Q:'$D(PRCHPO) I X>9!'X W " ??",$C(7) G EN40
29 D LCK1 G:'$D(DA) EN40 D ^PRCHNPO L
30 G EN40
31 ;
32EN5 ;RECEIVING FOR IMPREST FUND P.O.
33 S PRCHPGM="EN5^PRCHEB",PRCHIMP=1 D ^PRCHREC K PRCHPGM,PRCHIMP
34 Q
35 ;
36EN6 ;CANCEL UNOBLIGATED IF P.O.
37 S PRCHIMP=1 D EN7^PRCHEA K PRCHIMP
38 Q
39 ;
40EN7 ;REMOVE 2237 FROM IF P.O.
41 S PRCHIMP=1 D ^PRCHE2 K PRCHIMP
42 Q
43 ;
44EN8 ;ENTER COMPLETED DEPOT/GSA PUSH P.O. IN REGISTER
45 D ST Q:'$D(PRC("SITE"))
46 W !!!,"NOTE: This option will just reserve the PAT (P.O.) numbers needed for",!,"a DEPOT or GSA PUSH transaction. It will take 3 entries to complete the",!
47 W "order (Regular, Drugs & Subsistence). The Control Point obligated balance for",!
48 W "the warehouse will NOT be updated. Both the PUSH RELEASE (acquisitions",!,"and the RECEIPTS RELEASE (receiving) LOG code sheets must be generated",!,"using the 'CREATE A CODE SHEET' option."
49EN80 S PRCHNRQ=1,PRCHP("A")="REQUISITION NUMBER",PRCHP("T")=8,PRCHP("S")=1,PRCHP("S2")=",$P(^(0),U,1)[""G""" D EN^PRCHPAT I '$D(PRCHPO) K PRCHNRQ G Q^PRCHEA
50 D LCK1 G:'$D(DA) EN80 S PRCHPUSH=1,DIE=DIC,DR="[PRCHPUSH]" D ^DIE,EN3^PRCHNPO7 L
51 G EN80
52 ;
53EN9 ;EDIT COMPLETED DEPOT/GSA PUSH P.O. IN REGISTER
54 D ST Q:'$D(PRC("SITE"))
55EN90 S PRCHNRQ=1,PRCHP("A")="REQUISITION NUMBER: ",PRCHP("T")=8,PRCHP("S")="$P(^(0),U,1)[""G""" D EN3^PRCHPAT I '$D(PRCHPO) K PRCHNRQ G Q^PRCHEA
56 I X>9!'X W " ??",$C(7) G EN90
57 D LCK1 G:'$D(DA) EN90 S PRCHPUSH=1,DIE=DIC,DR="[PRCHPUSH]" D ^DIE,EN3^PRCHNPO7 L
58 G EN90
59 ;
60ENA ;CHANGE DELIVERY DATE ON REQUISITION
61 S PRCHNRQ=1 D EN12^PRCHE K PRCHNRQ
62 Q
63 ;
64ENB ;RETURN SUPPLY FUND P.O. FROM PPM TO P&C FOR RE-EDITING
65 D ST Q:'$D(PRC("SITE"))
66ENB1 S PRCHP("S")="""137""[$P(^(0),U,2),$P(^(0),U,19)=2,$D(^(7)),$P(^(7),U,2)=22,$D(^PRC(442,""AE"",""N"",+Y))"
67 D EN3^PRCHPAT G:Y'>0 Q
68 W !,$C(7) S %A="Are you sure that you want to return this to P&C for re-editing"
69 S %=1,%B="Answering 'YES' will remove the Purchasing Agent's signature so that they",%B(1)="can re-edit the P.O." D ^PRCFYN G:%=2 ENB1 I %<0 W !,"No Action Taken." R X:3 G ENB1
70 S DA=PRCHPO D LCK1 G:'$D(DA) ENB1
71 ;S $P(^PRC(442,DA,12),"^",2,3)="^",X=6 D ENS^PRCHSTAT W !,"Purchase Order has been returned, please notify P&C, IMMEDIATELY",$C(7),! L G Q
72 D REMOVE^PRCHES5(DA) S X=6 D ENS^PRCHSTAT W !,"Purchase Order has been returned, please notify P&C, IMMEDIATELY",$C(7),! L
73 G Q
74 ;
75Q K DA,DIC,PRC,PRCF,PRCHP,PRCHPO
76 Q
77 ;
78LCK1 S DIC="^PRC(442,"
79 ;
80LCK L @(DIC_DA_"):0") E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
81 Q
82 ;
83ST S PRCF("X")="S" D ^PRCFSITE
84 Q
Note: See TracBrowser for help on using the repository browser.