| 1 | PRCHEI ;WISC/RWS-EDIT ROUTINES FOR ISMS CODE SHEETS ; 4/13/00 2:51pm
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN1 ;CREATE ACQUISITIONS LOG CODE SHEETS, UPDATE OBLIGATED BALANCE (IF SUPPLY FUND P.O.)
|
|---|
| 6 | D ST G:'$D(PRC("SITE")) Q D ASK^PRCHEC1 G:%=-1 Q I %=1 S PRCHQ="EN1" D EN^PRCHRCS
|
|---|
| 7 | EN01 Q:'$D(PRC("SITE")) G:$D(PRCHENT) Q2 S PRCHP("S")="$D(^PRC(442,""AE"",""N"",+Y))" D PO G:'$D(PRCHPO) Q
|
|---|
| 8 | I $D(^PRC(442,PRCHPO,1)),"013"[$P(^(1),U,7) S PRCHNRQ=1
|
|---|
| 9 | S %=1,%B="",%A=" Review Order " D ^PRCFYN G:%=-1 Q I %=1 S D0=PRCHPO D ^PRCHDP1
|
|---|
| 10 | ;
|
|---|
| 11 | EN11(PRCHTYP) ;ENTRY POINT IF CALLED WHEN REQUISITION SIGNED.
|
|---|
| 12 | D SETUP^PRCHEC1
|
|---|
| 13 | I $D(^PRC(442,PRCHPO,18)),$P(^(18),U,6)]"" D ERR G EN01
|
|---|
| 14 | D LCK1 G:'$D(DA) EN01
|
|---|
| 15 | D EDIT^PRCHEC1 G:'$D(PRCHPO) EN01 S PRCHKEY=PRCHPONO W !!!
|
|---|
| 16 | D GT G:'% EN01
|
|---|
| 17 | D NEW^PRCHHI(PRCHPO,PRCHTYP,$G(PRCHRD))
|
|---|
| 18 | L @("-"_DIC_DA_")") G Q2
|
|---|
| 19 | ;
|
|---|
| 20 | Q K PRC,PRCHPO,PRCHN,PRCHNM,PRCHNRQ
|
|---|
| 21 | ;
|
|---|
| 22 | Q2 K PRCF,PRCFA,PRCFASYS,PRCHCS,PRCHTP,PRCHAMT,PRCHCNT,PRCHENT,PRCHRPT,PRCHRD,PRCHCMI,PRCHEMG,PRCHEST,PRCHFA,PRCHLOG,PRCHDIET,PRCHDPT,PRCHDRD,PRCHDT,PRCHDTP,PRCHKEY,PRCHPONO,PRCHT,PRCHTP,PRCHTYP,X,Y,Z
|
|---|
| 23 | K PRCHNET,PRCHAMT,PRCHSTA,PRCHBL,PRCHLOOP,PRCHTRID,PRCHTRLE,SPFILL,PRCHITFI,PRCHDEFI,BLANKS,LP,PRCHLINO,PRCHLIFI,PRCHLITM,PRCHDESC,PRCHDESP,PRCHDELE,PRCHAPPR,PRCHAPLE,FILL,PRCHOB22,OBCL,CL22
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | LCK1 S DIC="^PRC(442,"
|
|---|
| 27 | ;
|
|---|
| 28 | LCK L @("+"_DIC_DA_"):0") E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ST S PRCF("X")="S" D ^PRCFSITE
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | PO S PRCHP("S")="""13478""[$P(^(0),U,2),"_PRCHP("S"),PRCHP("A")="P.O./REQ.NO.: " D EN3^PRCHPAT Q:'$D(PRCHPO) Q:'PRCHPO
|
|---|
| 35 | S PRCHSAVX=X S:'$D(^PRC(442,PRCHPO,18)) ^(18)="" I $P(^(18),U,3)="" D DOCID^PRCHUTL K Z
|
|---|
| 36 | S:'$D(^PRC(442,PRCHPO,17)) ^(17)="" I $P(^(17),U,1)="" D LOGDPT^PRCHEC2
|
|---|
| 37 | S X=PRCHSAVX K PRCHSAVX
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | GT S PRCFASYS="ISM",PRCFA("SYS")="ISM",PRCFA("REF")=$P(PRCHPONO,"-",2),PRCFA("TTLEN")="" S:$G(PRCHTRAN)'="" PRCFA("TTF")=PRCHTRAN D TT^PRCFAC Q:'%
|
|---|
| 41 | K PRCHTP S PRCHTP(1)="442,"_PRCHPO_",^PRC(442,"
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ERR W !?3,"LOG code sheets already created and signed. Use Edit A Code Sheet option.",$C(7)
|
|---|
| 45 | Q
|
|---|
