| 1 | PRCHEC ;SF-ISC/TKW-EDIT FOR SUPPLY SYSTEM--LOG CODE SHEETS ; 5/17/00 4:05pm
|
|---|
| 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(PRCHENT) D LCK1 G:'$D(DA) EN01
|
|---|
| 9 | I $D(^PRC(442,PRCHPO,1)),"013"[$P(^(1),U,7) S PRCHNRQ=1
|
|---|
| 10 | S %=1,%B="",%A=" Review Order " D ^PRCFYN G:%=-1 Q I %=1 S D0=PRCHPO D ^PRCHDP1
|
|---|
| 11 | ;
|
|---|
| 12 | EN11 ;ENTRY POINT IF CALLED WHEN REQUISITION SIGNED.
|
|---|
| 13 | S TAGLCK="EN01"
|
|---|
| 14 | D SETUP^PRCHEC1,CAL2^PRCHEC2
|
|---|
| 15 | I PRCHN("SFC")=2,PRCHN("MP")'=12,'$D(PRCHNRQ) D OBL^PRCHEC1 G:'$D(PRCHPO) Q I $P(^PRC(442,PRCHPO,0),U,2)=3 S X=40,DA=PRCHPO D ENS^PRCHSTAT
|
|---|
| 16 | I $D(^PRC(442,PRCHPO,18)),$P(^(18),U,6)]"" D ERR G:'$D(PRCHENT) UNLCK G EN01
|
|---|
| 17 | I $D(PRCHENT) D LCK1 G:'$D(DA) EN01 ;CALL FROM PRCHNRQ ROUTINE.
|
|---|
| 18 | S PRCHTYP="A" D EDIT^PRCHEC1 G:'$D(PRCHPO) UNLCK S PRCHKEY=PRCHPONO W !!!
|
|---|
| 19 | I PRCHN("SFC")'=2&("013"'[(PRCHN("SC"))) W $C(7),!,"NOT POSTED STOCK AND NOT A REQUISITION--ACQUISITION CODE SHEETS ARE",!,"NOT REQUIRED!!" G UNLCK
|
|---|
| 20 | I $D(PRCHNRQ),PRCHN("SFC")=2 S PRCFA("DICS")=$S(PRCHN("SC")=0:"I Y=100",PRCHN("SC")=1:"I Y=500!(Y=504)",PRCHN("SC")=3:"I Y=630",1:"I Y=630")
|
|---|
| 21 | I $D(PRCHNRQ),PRCHN("SFC")'=2 S PRCFA("DICS")=$S(PRCHN("SC")=0:"I Y=100",PRCHN("SC")=1:"I Y=501!(Y=505)!(Y=510)!(Y=514)!(Y=515)",1:"I Y=700")
|
|---|
| 22 | I '$D(PRCHNRQ) S PRCFA("DICS")="I Y=630"
|
|---|
| 23 | S PRCFA("TT")=+$P(PRCFA("DICS"),"=",2)
|
|---|
| 24 | I '$D(PRCHISMS) D GT G:'% UNLCK
|
|---|
| 25 | S Y=PRCFA("TT"),X=$S(Y=100:"B100",Y=700:"B700","501.505.510.514.515"[Y:"B501",1:"B500"),X=X_"^PRCHCS2" D @X
|
|---|
| 26 | D SC^PRCHCS0,^PRCHCS G UNLCK
|
|---|
| 27 | ;
|
|---|
| 28 | EN2 ;CREATE LOG RECEIPT CODE SHEETS
|
|---|
| 29 | D ST G:'$D(PRC("SITE")) Q D ASK^PRCHEC1 G:%=-1 Q I %=1 S PRCHQ="EN2" D EN^PRCHRCS
|
|---|
| 30 | ;
|
|---|
| 31 | EN20 Q:'$D(PRC("SITE")) S PRCHP("S")="$D(^PRC(442,""AF"",""N"",+Y))"
|
|---|
| 32 | S TAGLCK="EN20" D PO G:'$D(PRCHPO) Q I X<25!(X>44) W $C(7)," ??" G EN20
|
|---|
| 33 | D LCK1 G:'$D(DA) EN20
|
|---|
| 34 | I '$O(^PRC(442,PRCHPO,11,0)) W !?3,"P.O. has no Receiving Reports !",$C(7) G UNLCK
|
|---|
| 35 | S DIC="^PRC(442,PRCHPO,11,",DIC(0)="QEANZ" D ^DIC K DIC
|
|---|
| 36 | I Y<0 G UNLCK
|
|---|
| 37 | S (PRCHRPT,PRCHDPT)=+Y I '$D(Y(0)) G UNLCK
|
|---|
| 38 | S (PRCHRD,PRCHDRD)=$P(Y(0),U,1),PRCHCMI=$S($P(Y(0),U,9)="":"P",1:"")
|
|---|
| 39 | I $D(^PRC(442,PRCHPO,11,PRCHRPT,1)),$P(^(1),U,4)]"" D ERR G UNLCK
|
|---|
| 40 | D SETUP^PRCHEC1,CALTOT^PRCHEC2 S PRCHTYP="R" D EDIT^PRCHEC1
|
|---|
| 41 | I '$D(PRCHPO) G UNLCK
|
|---|
| 42 | S PRCHKEY=PRCHPONO_"."_PRCHRPT
|
|---|
| 43 | S PRCHDIET=$P($G(^PRC(442,PRCHPO,11,PRCHRPT,1)),U,2),PRCHDTP=1
|
|---|
| 44 | W !!! S %A="DISPLAY RECEIVING REPORT ONLINE ",%=2 D ^PRCFYN
|
|---|
| 45 | I %=-1 G UNLCK
|
|---|
| 46 | I %=1 D ^PRCHDP3
|
|---|
| 47 | W !!!
|
|---|
| 48 | S PRCFA("DICS")=$S(PRCHN("SC")=1&(PRCHN("SFC")=2):"I Y=551",PRCHN("SC")=1:"I Y=552",PRCHN("SFC")=2:"I Y=632!(Y=633)",1:"I Y=710!(Y=711)")
|
|---|
| 49 | S PRCFA("TT")=+$P(PRCFA("DICS"),"=",2),PRCHN("FMO")=$E("1234567890JK",+$E(PRCHRD,4,5))
|
|---|
| 50 | D GT G:'% UNLCK
|
|---|
| 51 | S Y=PRCFA("TT"),X=$S(Y=551:"B551",Y=552:"B552",Y=710:"B710",1:"B632"),X=X_"^PRCHCS7" D @X
|
|---|
| 52 | I PRCFA("TT")["55" D
|
|---|
| 53 | . D ^PRCHCS8
|
|---|
| 54 | E D
|
|---|
| 55 | . D SC^PRCHCS0,^PRCHCS
|
|---|
| 56 | G UNLCK
|
|---|
| 57 | ;
|
|---|
| 58 | Q K PRC,PRCHPO,PRCHN,PRCHNM,PRCHNRQ,TAGLCK
|
|---|
| 59 | ;
|
|---|
| 60 | 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
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | EN3 ;CREATE REPORT OF CODE SHEETS TO BE GENERATED, FOR PPM
|
|---|
| 64 | ;
|
|---|
| 65 | LCK1 S DIC="^PRC(442,"
|
|---|
| 66 | ;
|
|---|
| 67 | LCK I $G(DA) D
|
|---|
| 68 | . S HLDDA=DA
|
|---|
| 69 | E D
|
|---|
| 70 | . S:$G(PRCHPO) (HLDDA,DA)=PRCHPO
|
|---|
| 71 | L @("+"_DIC_DA_"):0") E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
|
|---|
| 72 | Q
|
|---|
| 73 | UNLCK ;
|
|---|
| 74 | I $G(HLDDA) D
|
|---|
| 75 | . S DA=HLDDA
|
|---|
| 76 | E D
|
|---|
| 77 | . S:$G(PRCHPO) DA=PRCHPO
|
|---|
| 78 | S DIC="^PRC(442,"
|
|---|
| 79 | L @("-"_DIC_DA_")")
|
|---|
| 80 | K HLDDA
|
|---|
| 81 | G @TAGLCK
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | ST S PRCF("X")="S" D ^PRCFSITE
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | 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
|
|---|
| 88 | S PRCHSAVX=X S:'$D(^PRC(442,PRCHPO,18)) ^(18)="" I $P(^(18),U,3)="" D DOCID^PRCHUTL K Z
|
|---|
| 89 | S:'$D(^PRC(442,PRCHPO,17)) ^(17)="" I $P(^(17),U,1)="" D LOGDPT^PRCHEC2
|
|---|
| 90 | S X=PRCHSAVX K PRCHSAVX
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | GT S PRCHLOG=1,PRCFASYS="LOG" D TT^PRCFAC Q:'% S PRCFA("TTF")=PRCFA("TT")
|
|---|
| 94 | K PRCHTP S PRCHTP(1)="442,"_PRCHPO_",^PRC(442,",PRCHTP(2)="442.01,PRCHLI,^PRC(442,"_PRCHPO_",2,"
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | ERR W !?3,"LOG code sheets already created and signed. Use Edit A Code Sheet option.",$C(7)
|
|---|
| 98 | Q
|
|---|
