| 1 | PRCHCNV ; Covert purchase card orders to delivery orders and vice versa ;7/24/00 23:29
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | QUIT
|
|---|
| 6 | PCDO ;Convert a purchase card order to a delivery order
|
|---|
| 7 | ;
|
|---|
| 8 | S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
|
|---|
| 9 | N DIC,I,N,PRCHA,PRCHCARD,PRCHHLDR,PRCHNPO,PRCHDELV,PRCHPO,Y
|
|---|
| 10 | S DIC="^PRC(442,",DIC(0)="AEQM"
|
|---|
| 11 | S DIC("S")="I $P($G(^PRC(442,+Y,23)),U,11)=""P"",$P(^PRC(442,+Y,7),U,2)<9,$P(^PRC(442,+Y,1),U,10)=DUZ"
|
|---|
| 12 | S DIC("A")="Select PURCHASE CARD ORDER NUMBER: "
|
|---|
| 13 | D ^DIC Q:Y'>0 S PRCHOLD=+Y
|
|---|
| 14 | S PRCHDELV=1 D ENPO^PRCHUTL Q:'$D(PRCHPO) S (DA,PRCHNEW)=PRCHPO
|
|---|
| 15 | S PRCHNPO=$P(^PRC(442,PRCHNEW,0),U)
|
|---|
| 16 | S %X="^PRC(442,PRCHOLD,",%Y="^PRC(442,PRCHNEW," D %XY^%RCR K %X,%Y
|
|---|
| 17 | S DIE="^PRC(442,"
|
|---|
| 18 | S DR=".01///^S X=PRCHNPO;48///^S X=""D"";.02///^S X=1;27///^S X=PRCHOLD"
|
|---|
| 19 | D ^DIE K DIE,DA,DR
|
|---|
| 20 | F I=8,15,16,17,20,21,22 S $P(^PRC(442,PRCHNEW,23),U,I)=""
|
|---|
| 21 | S PRCHCARD=$P(^PRC(442,PRCHOLD,23),U,8),PRCHHLDR=$P(^(23),U,22)
|
|---|
| 22 | K:$G(PRCHCARD) ^PRC(442,"M",PRCHCARD,PRCHOLD)
|
|---|
| 23 | K:$G(PRCHHLDR) ^PRC(442,"MCH",PRCHHLDR_"~",PRCHOLD)
|
|---|
| 24 | S DIE="^PRC(442,",DA=PRCHOLD
|
|---|
| 25 | S DR=".5///^S X=45;28///^S X=PRCHNEW"
|
|---|
| 26 | D ^DIE K DIE,DA,DR
|
|---|
| 27 | S DA=PRCHOLD D C2237^PRCH442A
|
|---|
| 28 | W !!,"This purchase card order has now been converted to a delivery order."
|
|---|
| 29 | W !!,?5,"The Purchase Card Order No: "_$P($P(^PRC(442,PRCHOLD,0),U),"-",2)_" has been converted",!,?5,"to Delivery Order No: "_$P($P(^PRC(442,PRCHNEW,0),U),"-",2)
|
|---|
| 30 | S PRCHA=""
|
|---|
| 31 | S N=0 F S N=$O(^PRC(442,PRCHNEW,2,N)) Q:'N I $P($G(^(N,2)),U,2)="" S PRCHA=PRCHA_N_","
|
|---|
| 32 | I PRCHA]"" D
|
|---|
| 33 | . W !!,?5,"The following line items on the new delivery order",!,?5," do not have a contract number: ",!,?5,PRCHA,!
|
|---|
| 34 | W !!,?5,"This delivery order must be edited."
|
|---|
| 35 | K PRCF,PRCHOLD,PRCHNEW,PRCHDELV
|
|---|
| 36 | N DIR S DIR(0)="E" W !!! D ^DIR
|
|---|
| 37 | QUIT
|
|---|
| 38 | ;
|
|---|
| 39 | DOPC ;Convert a delivery order to a purchase card order
|
|---|
| 40 | ;
|
|---|
| 41 | S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
|
|---|
| 42 | N DIC,PRCHNPO,PRCHPC,PRCHPO,Y
|
|---|
| 43 | S DIC="^PRC(442,",DIC(0)="AEQM"
|
|---|
| 44 | S DIC("S")="I $P($G(^(23)),U,11)=""D"",$P(^(7),U,2)<9"
|
|---|
| 45 | S DIC("A")="Select DELIVERY ORDER NUMBER: "
|
|---|
| 46 | D ^DIC Q:Y'>0 S PRCHOLD=+Y
|
|---|
| 47 | S PRCHPC=2 D ENPO^PRCHUTL Q:'$D(PRCHPO) S (DA,PRCHNEW)=PRCHPO
|
|---|
| 48 | S PRCHNPO=$P(^PRC(442,PRCHNEW,0),U)
|
|---|
| 49 | S %X="^PRC(442,PRCHOLD,",%Y="^PRC(442,PRCHNEW," D %XY^%RCR
|
|---|
| 50 | S DIE="^PRC(442,",DR=".01///^S X=PRCHNPO;48///^S X=""P"";.02///^S X=25;27///^S X=PRCHOLD;.04///^S X=""@"""
|
|---|
| 51 | D ^DIE K DIE,DA,DR
|
|---|
| 52 | K ^PRC(442,PRCHNEW,5)
|
|---|
| 53 | S DIE="^PRC(442,",DA=PRCHOLD,DR=".5///^S X=45;28///^S X=PRCHNEW"
|
|---|
| 54 | D ^DIE K DIE,DA,DR
|
|---|
| 55 | S DA=PRCHOLD D C2237^PRCH442A
|
|---|
| 56 | W !!,"This delivery order is now converted to a purchase card order"
|
|---|
| 57 | W !!,?5,"The Deliver Order No: "_$P($P(^PRC(442,PRCHOLD,0),U),"-",2)_" has been converted",!,?5,"to Purchase Card Order No: "_$P($P(^PRC(442,PRCHNEW,0),U),"-",2)
|
|---|
| 58 | W !!,?5,"This purchase card order must be edited."
|
|---|
| 59 | K PRCF,PRCHOLD,PRCHNEW
|
|---|
| 60 | N DIR S DIR(0)="E" W !!! D ^DIR
|
|---|
| 61 | QUIT
|
|---|
