| [613] | 1 | PRCHCS8 ;WISC/RHD-EDIT DEPOT RECEIVING LOG CODE SHEETS ;12/1/93 09:53
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN S PRCHN("PO")=$P($P(^PRC(442,PRCHPO,0),"-",2),U,1),PRCFA("SYS")="LOG",PRCFA("REF")=PRCHN("PO"),PRCHAUTO="" W !," Now creating LOG code sheets ."
|
|---|
| 5 | S DA=$P($G(^PRC(442,PRCHPO,11,PRCHRPT,1)),U,7)
|
|---|
| 6 | I 'DA D ^PRCHCS1 Q:'$D(PRCFA) W "."
|
|---|
| 7 | S:'$D(DA) DA="" I 'DA W !,"No code sheets created !",$C(7) K PRCHPO G Q
|
|---|
| 8 | 1 S PRCH=DA,IOP="" D:'$D(IOF) ^%ZIS W !! D HDR^PRCHCS0
|
|---|
| 9 | 11 I '$D(^PRCF(423,PRCH,300))!('$D(^("CODE",1,0))) D ERR1 G 3
|
|---|
| 10 | S Y=^PRCF(423,PRCH,"CODE",1,0) W !,Y I $L(Y)'=80!($O(^PRCF(423,PRCH,"CODE",1))) D ERR^PRCHCS0 G 3
|
|---|
| 11 | 2 W ! S %A="Do you want to transmit this code sheet",%B="'YES' will mark the code sheets for transmission.",%B(1)="'NO' will give you a chance to edit code sheet."
|
|---|
| 12 | S %B(2)="'^' will delete code sheet." D ^PRCFYN G TRAN:%=1,DEL1:%<0
|
|---|
| 13 | 3 S %A="Do you want to edit this code sheet",%B="'YES' to edit code sheet.",%B(1)="'NO' or '^' for chance to delete code sheet." D ^PRCFYN G DEL:%'=1
|
|---|
| 14 | 4 K PRCHLOG S DIE="^PRCF(423,",DA=PRCH,DR=PRCFA("EDIT") D ^DIE S PRCHLOG=1 D ^PRCFACX1
|
|---|
| 15 | G 1
|
|---|
| 16 | TRAN I '$D(DT) D NOW^%DTC S DT=$P(%,".",1)
|
|---|
| 17 | S %DT="AEXF",%DT("A")="TRANSMISSION DATE: ",%DT("B")="TODAY",%DT(0)=DT D ^%DT G:Y<0 3 S PRCHDT=Y
|
|---|
| 18 | D SIG^PRCHCS0 I '$D(PRCHNM) D:$D(PRCHLOG) DEL1 K PRCHPO G Q
|
|---|
| 19 | S DA=PRCH,PRCHBTYP=5 D MRK^PRCHCS
|
|---|
| 20 | W !!,$C(7),"CODE SHEET MARKED FOR TRANSMISSION!"
|
|---|
| 21 | Q G Q^PRCHCS0
|
|---|
| 22 | ERR1 W !?5,"Code sheet has not been completed and needs to be edited !",$C(7)
|
|---|
| 23 | W !! S %A="Do you want to re-create the code sheet",%B="'YES' will rebuild the code sheet from the P.O. data as it was before",%B(1)="editing. Any other answer will do nothing.",%=1 D ^PRCFYN Q:%'=1
|
|---|
| 24 | D ^PRCHCS1 Q:'$D(PRCFA) I $D(DA),DA S PRCH=DA
|
|---|
| 25 | Q
|
|---|
| 26 | DEL S %=1,%A="Delete code sheet for this "_$S(PRCHTYP="R":"Partial",1:"Order"),%B="'YES' or '^' to delete the code sheet.",%B(1)="'NO' to have another chance to transmit." D ^PRCFYN G:%=2 1
|
|---|
| 27 | DEL1 ;DELETES ALL CODE SHEETS
|
|---|
| 28 | S DIK="^PRCF(423,",DA=PRCH D ^DIK K DIK S DA="" D SETR^PRCHCS1
|
|---|
| 29 | W !,"CODE SHEET DELETED FOR THIS "_$S(PRCHTYP="R":"PARTIAL",1:"ORDER")_" !",$C(7) K PRCHPO G Q
|
|---|
