PRCHCNV ;ALB/TXH - Convert purchase card orders to delivery orders and vice versa ;7/24/00 23:29
;;5.1;IFCAP;**217**;Oct 20, 2000;Build 4
;Per VA Directive 6402, this routine should not be modified.
;
QUIT
PCDO ;Convert a purchase card order to a delivery order
;
S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
N DIC,I,N,PRCHA,PRCHCARD,PRCHHLDR,PRCHNPO,PRCHDELV,PRCHPO,Y
S DIC="^PRC(442,",DIC(0)="AEQM"
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"
S DIC("A")="Select PURCHASE CARD ORDER NUMBER: "
D ^DIC Q:Y'>0 S PRCHOLD=+Y
S PRCHDELV=1 D ENPO^PRCHUTL Q:'$D(PRCHPO) S (DA,PRCHNEW)=PRCHPO
S PRCHNPO=$P(^PRC(442,PRCHNEW,0),U)
S %X="^PRC(442,PRCHOLD,",%Y="^PRC(442,PRCHNEW," D %XY^%RCR K %X,%Y
S DIE="^PRC(442,"
S DR=".01///^S X=PRCHNPO;48///^S X=""D"";.02///^S X=1;27///^S X=PRCHOLD;63///@" ;PRC*5.1*217
D ^DIE K DIE,DA,DR
F I=8,15,16,17,20,21,22 S $P(^PRC(442,PRCHNEW,23),U,I)=""
S PRCHCARD=$P(^PRC(442,PRCHOLD,23),U,8),PRCHHLDR=$P(^(23),U,22)
K:$G(PRCHCARD) ^PRC(442,"M",PRCHCARD,PRCHOLD)
K:$G(PRCHHLDR) ^PRC(442,"MCH",PRCHHLDR_"~",PRCHOLD)
S DIE="^PRC(442,",DA=PRCHOLD
S DR=".5///^S X=45;28///^S X=PRCHNEW"
D ^DIE K DIE,DA,DR
S DA=PRCHOLD D C2237^PRCH442A
W !!,"This purchase card order has now been converted to a delivery order."
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)
S PRCHA=""
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_","
I PRCHA]"" D
. W !!,?5,"The following line items on the new delivery order",!,?5," do not have a contract number: ",!,?5,PRCHA,!
W !!,?5,"This delivery order must be edited."
K PRCF,PRCHOLD,PRCHNEW,PRCHDELV
N DIR S DIR(0)="E" W !!! D ^DIR
QUIT
;
DOPC ;Convert a delivery order to a purchase card order
;
S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
N DIC,PRCHNPO,PRCHPC,PRCHPO,Y
S DIC="^PRC(442,",DIC(0)="AEQM"
S DIC("S")="I $P($G(^(23)),U,11)=""D"",$P(^(7),U,2)<9"
S DIC("A")="Select DELIVERY ORDER NUMBER: "
D ^DIC Q:Y'>0 S PRCHOLD=+Y
S PRCHPC=2 D ENPO^PRCHUTL Q:'$D(PRCHPO) S (DA,PRCHNEW)=PRCHPO
S PRCHNPO=$P(^PRC(442,PRCHNEW,0),U)
S %X="^PRC(442,PRCHOLD,",%Y="^PRC(442,PRCHNEW," D %XY^%RCR
S DIE="^PRC(442,",DR=".01///^S X=PRCHNPO;48///^S X=""P"";.02///^S X=25;27///^S X=PRCHOLD;.04///^S X=""@"""
D ^DIE K DIE,DA,DR
K ^PRC(442,PRCHNEW,5)
S DIE="^PRC(442,",DA=PRCHOLD,DR=".5///^S X=45;28///^S X=PRCHNEW"
D ^DIE K DIE,DA,DR
S DA=PRCHOLD D C2237^PRCH442A
W !!,"This delivery order is now converted to a purchase card order"
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)
W !!,?5,"This purchase card order must be edited."
K PRCF,PRCHOLD,PRCHNEW
N DIR S DIR(0)="E" W !!! D ^DIR
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHCNV 2980 printed Sep 23, 2025@19:42:12 Page 2
PRCHCNV ;ALB/TXH - Convert purchase card orders to delivery orders and vice versa ;7/24/00 23:29
+1 ;;5.1;IFCAP;**217**;Oct 20, 2000;Build 4
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
PCDO ;Convert a purchase card order to a delivery order
+1 ;
+2 SET PRCF("X")="S"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
+3 NEW DIC,I,N,PRCHA,PRCHCARD,PRCHHLDR,PRCHNPO,PRCHDELV,PRCHPO,Y
+4 SET DIC="^PRC(442,"
SET DIC(0)="AEQM"
+5 SET 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"
+6 SET DIC("A")="Select PURCHASE CARD ORDER NUMBER: "
+7 DO ^DIC
if Y'>0
QUIT
SET PRCHOLD=+Y
+8 SET PRCHDELV=1
DO ENPO^PRCHUTL
if '$DATA(PRCHPO)
QUIT
SET (DA,PRCHNEW)=PRCHPO
+9 SET PRCHNPO=$PIECE(^PRC(442,PRCHNEW,0),U)
+10 SET %X="^PRC(442,PRCHOLD,"
SET %Y="^PRC(442,PRCHNEW,"
DO %XY^%RCR
KILL %X,%Y
+11 SET DIE="^PRC(442,"
+12 ;PRC*5.1*217
SET DR=".01///^S X=PRCHNPO;48///^S X=""D"";.02///^S X=1;27///^S X=PRCHOLD;63///@"
+13 DO ^DIE
KILL DIE,DA,DR
+14 FOR I=8,15,16,17,20,21,22
SET $PIECE(^PRC(442,PRCHNEW,23),U,I)=""
+15 SET PRCHCARD=$PIECE(^PRC(442,PRCHOLD,23),U,8)
SET PRCHHLDR=$PIECE(^(23),U,22)
+16 if $GET(PRCHCARD)
KILL ^PRC(442,"M",PRCHCARD,PRCHOLD)
+17 if $GET(PRCHHLDR)
KILL ^PRC(442,"MCH",PRCHHLDR_"~",PRCHOLD)
+18 SET DIE="^PRC(442,"
SET DA=PRCHOLD
+19 SET DR=".5///^S X=45;28///^S X=PRCHNEW"
+20 DO ^DIE
KILL DIE,DA,DR
+21 SET DA=PRCHOLD
DO C2237^PRCH442A
+22 WRITE !!,"This purchase card order has now been converted to a delivery order."
+23 WRITE !!,?5,"The Purchase Card Order No: "_$PIECE($PIECE(^PRC(442,PRCHOLD,0),U),"-",2)_" has been converted",!,?5,"to Delivery Order No: "_$PIECE($PIECE(^PRC(442,PRCHNEW,0),U),"-",2)
+24 SET PRCHA=""
+25 SET N=0
FOR
SET N=$ORDER(^PRC(442,PRCHNEW,2,N))
if 'N
QUIT
IF $PIECE($GET(^(N,2)),U,2)=""
SET PRCHA=PRCHA_N_","
+26 IF PRCHA]""
Begin DoDot:1
+27 WRITE !!,?5,"The following line items on the new delivery order",!,?5," do not have a contract number: ",!,?5,PRCHA,!
End DoDot:1
+28 WRITE !!,?5,"This delivery order must be edited."
+29 KILL PRCF,PRCHOLD,PRCHNEW,PRCHDELV
+30 NEW DIR
SET DIR(0)="E"
WRITE !!!
DO ^DIR
+31 QUIT
+32 ;
DOPC ;Convert a delivery order to a purchase card order
+1 ;
+2 SET PRCF("X")="S"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
+3 NEW DIC,PRCHNPO,PRCHPC,PRCHPO,Y
+4 SET DIC="^PRC(442,"
SET DIC(0)="AEQM"
+5 SET DIC("S")="I $P($G(^(23)),U,11)=""D"",$P(^(7),U,2)<9"
+6 SET DIC("A")="Select DELIVERY ORDER NUMBER: "
+7 DO ^DIC
if Y'>0
QUIT
SET PRCHOLD=+Y
+8 SET PRCHPC=2
DO ENPO^PRCHUTL
if '$DATA(PRCHPO)
QUIT
SET (DA,PRCHNEW)=PRCHPO
+9 SET PRCHNPO=$PIECE(^PRC(442,PRCHNEW,0),U)
+10 SET %X="^PRC(442,PRCHOLD,"
SET %Y="^PRC(442,PRCHNEW,"
DO %XY^%RCR
+11 SET DIE="^PRC(442,"
SET DR=".01///^S X=PRCHNPO;48///^S X=""P"";.02///^S X=25;27///^S X=PRCHOLD;.04///^S X=""@"""
+12 DO ^DIE
KILL DIE,DA,DR
+13 KILL ^PRC(442,PRCHNEW,5)
+14 SET DIE="^PRC(442,"
SET DA=PRCHOLD
SET DR=".5///^S X=45;28///^S X=PRCHNEW"
+15 DO ^DIE
KILL DIE,DA,DR
+16 SET DA=PRCHOLD
DO C2237^PRCH442A
+17 WRITE !!,"This delivery order is now converted to a purchase card order"
+18 WRITE !!,?5,"The Deliver Order No: "_$PIECE($PIECE(^PRC(442,PRCHOLD,0),U),"-",2)_" has been converted",!,?5,"to Purchase Card Order No: "_$PIECE($PIECE(^PRC(442,PRCHNEW,0),U),"-",2)
+19 WRITE !!,?5,"This purchase card order must be edited."
+20 KILL PRCF,PRCHOLD,PRCHNEW
+21 NEW DIR
SET DIR(0)="E"
WRITE !!!
DO ^DIR
+22 QUIT
