- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHPCAR.m
r613 r623 1 PRCHPCAR ;WISC/AKS-Front End questions for Purchase Card processes ;6/9/96 21:40 2 ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ASKPO ;Ask If they are processing a purchase or a requisition 5 N DIR,Y,PRCHPR,PRCHNE 6 S DIR(0)="SO^P:PURCHASE ORDER;R:REQUISITION" 7 S DIR("A")="Select THE TYPE OF ORDER" 8 D ^DIR Q:Y']""!(Y["^") S PRCHPR=Y 9 ENTED ;Ask if they are entering or editting 10 S DIR(0)="SO^N:NEW;E:EDIT AN EXISTING ORDER" 11 S DIR("A")="Select TYPE OF PROCESSING" 12 D ^DIR G:Y']"" ASKPO Q:Y["^" S PRCHNE=Y 13 I $G(PRCHPR)="P"&(PRCHNE="N") D EN5^PRCHE Q 14 I $G(PRCHPR)="P"&(PRCHNE="E") D EN6^PRCHE Q 15 I $G(PRCHPR)="R"&(PRCHNE="N") D EN3^PRCHEA Q 16 I $G(PRCHPR)="R"&(PRCHNE="E") D EN4^PRCHEA Q 17 I '$D(PRCHPR)&(PRCHNE="N") D EN5^PRCHE Q 18 I '$D(PRCHPR)&(PRCHNE="E") D EN6^PRCHE Q 19 QUIT 20 AMPO ;ask if they are amending a po or a requisition 21 N DIR,Y 22 S DIR(0)="SO^P:AMEND A PURCHASE ORDER;R:AMEND A REQUISITION" 23 S DIR("A")="Select THE TYPE OF ORDER" 24 D ^DIR 25 I Y="P" D PO^PRCHMA Q 26 I Y="R" D REQ^PRCHMA Q 27 QUIT 28 ADJPO ;ask if they are adjusting a po or requisition 29 N DIR,Y 30 S DIR(0)="SO^P:Adjustment Voucher to a PO;R:Adjustment Voucher to a Requisition" 31 S DIR("A")="Select THE TYPE OF ORDER" 32 D ^DIR 33 I Y="P" D EN14^PRCHE Q 34 I Y="R" D EN2^PRCHEB Q 35 QUIT 36 DIRPO ;Ask type of amendments for purchase card and delivery orders 37 ; 38 N PRCHTYPE,DIR 39 S PRCHTYPE=$P($G(^PRC(442,PRCHPO,23)),U,11) 40 Q:PRCHTYPE="" 41 S:PRCHTYPE="S" DIR(0)="SO^1:F.C.P. Edit;2:Change VENDOR;3:AUTHORITY Edit;4:LINE ITEM Edit" 42 S:PRCHTYPE="P" DIR(0)="SO^1:F.C.P. Edit;2:Change VENDOR;3:AUTHORITY Edit;4:LINE ITEM Add;5:LINE ITEM Delete;6:LINE ITEM Edit;7:F.O.B. Point" 43 S:PRCHTYPE="D" DIR(0)="SO^1:Change VENDOR;2:AUTHORITY Edit;3:LINE ITEM Add;4:LINE ITEM Delete;5:LINE ITEM Edit;6:F.O.B. Point;7:SHIP TO Edit;8:Edit MAIL INVOICE TO;9:EST. SHIPPING Edit;10:PROMPT PAYMENT Edit" 44 S DIR("A")="Select TYPE OF AMENDMENT NUMBER" 45 D ^DIR 46 I PRCHTYPE="S" S:$G(Y)=4 Y=6 47 I PRCHTYPE="D",$G(Y) S Y=Y+1 48 S Y=$S(Y=1:30,Y=2:31,Y=3:34,Y=4:21,Y=5:22,Y=6:23,Y=7:35,Y=8:20,Y=9:25,Y=10:29,Y=11:33,1:-1) 49 QUIT 50 DIRREQ ;Ask type of amendments for purchase card and delivery orders 51 ; 52 N PRCHTYPE,DIR 53 S PRCHTYPE=$P($G(^PRC(442,PRCHPO,23)),U,11) 54 Q:PRCHTYPE="" 55 S:PRCHTYPE="S" DIR(0)="SO^1:F.C.P. Edit;2:Change FEDERAL VENDOR" 56 S:PRCHTYPE="P" DIR(0)="SO^1:F.C.P. Edit;2:Change FEDERAL VENDOR;3:LINE ITEM Add;4:LINE ITEM Delete;5:LINE ITEM Edit" 57 S:PRCHTYPE="D" DIR(0)="SO^1:Change FEDERAL VENDOR;2:LINE ITEM Add;3:LINE ITEM Delete;4:LINE ITEM Edit;5:SHIP TO Edit;6:Edit MAIL INVOICE TO;7:EST. SHIPPING Edit" 58 S DIR("A")="Select TYPE OF AMENDMENT NUMBER" 59 D ^DIR 60 I PRCHTYPE="D",$G(Y) S Y=Y+1 61 S Y=$S(Y=1:30,Y=2:31,Y=3:21,Y=4:22,Y=5:23,Y=6:20,Y=7:25,Y=8:29,1:-1) 62 QUIT 63 CANPC ;Cancel a purchase card order 64 W ! S DIC="^PRC(442,",DIC(0)="AEQM" 65 S DIC("A")="Select PURCHASE CARD ORDER NUMBER: " 66 S DIC("S")="I $P($G(^(7)),U,2)<9,$P($G(^(1)),U,10)=DUZ,$P($G(^(0)),U,2)=25,($P($G(^(23)),U,11)=""P""!($P($G(^(23)),U,11)=""S""))" 67 D ^DIC Q:+Y<0 K DIC 68 S %A="Are sure you want to cancel this order",%B="",%=2 69 D ^PRCFYN I %<1!(%=2) K %A,%B,% Q 70 S DA=+Y,DIE="^PRC(442,",DR=".5///^S X=45" D ^DIE K DIE,DR 71 D C2237^PRCH442A 72 K DA,%A,%B,% 73 QUIT 74 CANDO ;Cancel a delivery order 75 W ! S DIC="^PRC(442,",DIC(0)="AEQM" 76 S DIC("A")="Select DELIVERY ORDER NUMBER: " 77 S DIC("S")="I $P($G(^(7)),U,2)<9,$P($G(^(23)),U,11)=""D""" 78 D ^DIC Q:+Y<0 K DIC 79 S %A="Are sure you want to cancel this order",%B="",%=2 80 D ^PRCFYN I %<1!(%=2) K %A,%B,% Q 81 S DA=+Y,DIE="^PRC(442,",DR=".5///^S X=45" D ^DIE K DIE,DR 82 D C2237^PRCH442A 83 K DA,%A,%B,% 84 QUIT 85 AOCANPC ;Approving Official Cancel a purchase card order 86 N DIC,Y,NREC,X 87 W ! S DIC="^PRC(442,",DIC(0)="AEQM" 88 S DIC("A")="Select PURCHASE CARD ORDER NUMBER: " 89 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""))" 90 D ^DIC Q:+Y<0 K DIC 91 S %A="Are sure you want to cancel this order",%B="",%=2 92 D ^PRCFYN I %<1!(%=2) K %A,%B,% Q 93 S DA=+Y,DIE="^PRC(442,",DR=".5///^S X=45" D ^DIE K DIE,DR 94 D C2237^PRCH442A 95 K DA,%A,%B,% 96 QUIT 1 PRCHPCAR ;WISC/AKS-Front End questions for Purchase Card processes ;6/9/96 21:40 2 ;;5.1;IFCAP;;Oct 20, 2000 3 ;Per VHA Directive 10-93-142, this routine should not be modified. 4 ASKPO ;Ask If they are processing a purchase or a requisition 5 N DIR,Y,PRCHPR,PRCHNE 6 S DIR(0)="SO^P:PURCHASE ORDER;R:REQUISITION" 7 S DIR("A")="Select THE TYPE OF ORDER" 8 D ^DIR Q:Y']""!(Y["^") S PRCHPR=Y 9 ENTED ;Ask if they are entering or editting 10 S DIR(0)="SO^N:NEW;E:EDIT AN EXISTING ORDER" 11 S DIR("A")="Select TYPE OF PROCESSING" 12 D ^DIR G:Y']"" ASKPO Q:Y["^" S PRCHNE=Y 13 I $G(PRCHPR)="P"&(PRCHNE="N") D EN5^PRCHE Q 14 I $G(PRCHPR)="P"&(PRCHNE="E") D EN6^PRCHE Q 15 I $G(PRCHPR)="R"&(PRCHNE="N") D EN3^PRCHEA Q 16 I $G(PRCHPR)="R"&(PRCHNE="E") D EN4^PRCHEA Q 17 I '$D(PRCHPR)&(PRCHNE="N") D EN5^PRCHE Q 18 I '$D(PRCHPR)&(PRCHNE="E") D EN6^PRCHE Q 19 QUIT 20 AMPO ;ask if they are amending a po or a requisition 21 N DIR,Y 22 S DIR(0)="SO^P:AMEND A PURCHASE ORDER;R:AMEND A REQUISITION" 23 S DIR("A")="Select THE TYPE OF ORDER" 24 D ^DIR 25 I Y="P" D PO^PRCHMA Q 26 I Y="R" D REQ^PRCHMA Q 27 QUIT 28 ADJPO ;ask if they are adjusting a po or requisition 29 N DIR,Y 30 S DIR(0)="SO^P:Adjustment Voucher to a PO;R:Adjustment Voucher to a Requisition" 31 S DIR("A")="Select THE TYPE OF ORDER" 32 D ^DIR 33 I Y="P" D EN14^PRCHE Q 34 I Y="R" D EN2^PRCHEB Q 35 QUIT 36 DIRPO ;Ask type of amendments for purchase card and delivery orders 37 ; 38 N PRCHTYPE,DIR 39 S PRCHTYPE=$P($G(^PRC(442,PRCHPO,23)),U,11) 40 Q:PRCHTYPE="" 41 S:PRCHTYPE="S" DIR(0)="SO^1:F.C.P. Edit;2:Change VENDOR;3:AUTHORITY Edit;4:LINE ITEM Edit" 42 S:PRCHTYPE="P" DIR(0)="SO^1:F.C.P. Edit;2:Change VENDOR;3:AUTHORITY Edit;4:LINE ITEM Add;5:LINE ITEM Delete;6:LINE ITEM Edit;7:F.O.B. Point" 43 S:PRCHTYPE="D" DIR(0)="SO^1:Change VENDOR;2:AUTHORITY Edit;3:LINE ITEM Add;4:LINE ITEM Delete;5:LINE ITEM Edit;6:F.O.B. Point;7:SHIP TO Edit;8:Edit MAIL INVOICE TO;9:EST. SHIPPING Edit;10:PROMPT PAYMENT Edit" 44 S DIR("A")="Select TYPE OF AMENDMENT NUMBER" 45 D ^DIR 46 I PRCHTYPE="S" S:$G(Y)=4 Y=6 47 I PRCHTYPE="D",$G(Y) S Y=Y+1 48 S Y=$S(Y=1:30,Y=2:31,Y=3:34,Y=4:21,Y=5:22,Y=6:23,Y=7:35,Y=8:20,Y=9:25,Y=10:29,Y=11:33,1:-1) 49 QUIT 50 DIRREQ ;Ask type of amendments for purchase card and delivery orders 51 ; 52 N PRCHTYPE,DIR 53 S PRCHTYPE=$P($G(^PRC(442,PRCHPO,23)),U,11) 54 Q:PRCHTYPE="" 55 S:PRCHTYPE="S" DIR(0)="SO^1:F.C.P. Edit;2:Change FEDERAL VENDOR" 56 S:PRCHTYPE="P" DIR(0)="SO^1:F.C.P. Edit;2:Change FEDERAL VENDOR;3:LINE ITEM Add;4:LINE ITEM Delete;5:LINE ITEM Edit" 57 S:PRCHTYPE="D" DIR(0)="SO^1:Change FEDERAL VENDOR;2:LINE ITEM Add;3:LINE ITEM Delete;4:LINE ITEM Edit;5:SHIP TO Edit;6:Edit MAIL INVOICE TO;7:EST. SHIPPING Edit" 58 S DIR("A")="Select TYPE OF AMENDMENT NUMBER" 59 D ^DIR 60 I PRCHTYPE="D",$G(Y) S Y=Y+1 61 S Y=$S(Y=1:30,Y=2:31,Y=3:21,Y=4:22,Y=5:23,Y=6:20,Y=7:25,Y=8:29,1:-1) 62 QUIT 63 CANPC ;Cancel a purchase card order 64 W ! S DIC="^PRC(442,",DIC(0)="AEQM" 65 S DIC("A")="Select PURCHASE CARD ORDER NUMBER: " 66 S DIC("S")="I $P($G(^(7)),U,2)<9,$P($G(^(1)),U,10)=DUZ,$P($G(^(0)),U,2)=25,($P($G(^(23)),U,11)=""P""!($P($G(^(23)),U,11)=""S""))" 67 D ^DIC Q:+Y<0 K DIC 68 S %A="Are sure you want to cancel this order",%B="",%=2 69 D ^PRCFYN I %<1!(%=2) K %A,%B,% Q 70 S DA=+Y,DIE="^PRC(442,",DR=".5///^S X=45" D ^DIE K DIE,DR 71 D C2237^PRCH442A 72 K DA,%A,%B,% 73 QUIT 74 CANDO ;Cancel a delivery order 75 W ! S DIC="^PRC(442,",DIC(0)="AEQM" 76 S DIC("A")="Select DELIVERY ORDER NUMBER: " 77 S DIC("S")="I $P($G(^(7)),U,2)<9,$P($G(^(23)),U,11)=""D""" 78 D ^DIC Q:+Y<0 K DIC 79 S %A="Are sure you want to cancel this order",%B="",%=2 80 D ^PRCFYN I %<1!(%=2) K %A,%B,% Q 81 S DA=+Y,DIE="^PRC(442,",DR=".5///^S X=45" D ^DIE K DIE,DR 82 D C2237^PRCH442A 83 K DA,%A,%B,% 84 QUIT
Note:
See TracChangeset
for help on using the changeset viewer.
