| [613] | 1 | PRCNREQE ;SSI/ALA,SEB-Edit a NX Request ;[ 02/06/97 11:55 AM ]
|
|---|
| 2 | ;;1.0;Equipment/Turn-In Request;**3,11,12,14**;Sep 13, 1996
|
|---|
| 3 | EN S DIC="^PRCN(413,",DIC(0)="AEQZ"
|
|---|
| 4 | I $G(PRCNCMF)="" S DIC("S")="S ST=$P(^(0),U,7) I ST=1!(ST=3)!(ST=4)!(ST=11)!(ST=12)!(ST=15)&($P(^(0),U,2)=DUZ)"
|
|---|
| 5 | I $G(PRCNCMF)'="" D
|
|---|
| 6 | . S PRCNC=DUZ D CMR^PRCNCMR K PRCNC
|
|---|
| 7 | . S DIC("S")="S ST=$P(^(0),U,7),CMRZ=$P(^(0),U,16) I ST=1!(ST=3)!(ST=5)!(ST=4)!(ST=11)!(ST=45)!(ST=17)!(ST=18)!(ST=15)&($D(PRCNCMR(CMRZ)))"
|
|---|
| 8 | D ^DIC K DIC("S") G EQ:Y<0 S IN=+Y,PRCNUSR=0 D SETUP^PRCNPRNT
|
|---|
| 9 | I $P($G(^PRCN(413,IN,2)),U,16)]"" S $P(^(2),U,16)="" K ^PRCN(413,IN,15)
|
|---|
| 10 | EDIT ; Edit the transaction if desired
|
|---|
| 11 | W !,"Do you want to edit this request" S %=2 D YN^DICN G EDIT:%=0
|
|---|
| 12 | G EQ:%'=1
|
|---|
| 13 | K NEW S DIE=413,DIE("NO^")="OUTOK",DR="[PRCNEDIT]",DA=IN D ^DIE
|
|---|
| 14 | I PRCNTY="R" D
|
|---|
| 15 | . I $G(TDA)="" S TDA=$P(^PRCN(413,DA,0),U,11)
|
|---|
| 16 | . I $G(PRCNTDA)="" S PRCNTDA=TDA
|
|---|
| 17 | . Q:$O(^PRCN(413.1,PRCNTDA,1,0))=""
|
|---|
| 18 | . S EDIT=2,DIE=413.1,DR="[PRCNTIRQ]",DA=PRCNTDA D ^DIE
|
|---|
| 19 | EQ K DIC,DIE,DA,DR,IN,PRCNUSR,PRCNQT,PRCNTXT,PRCNTY,PRCNCMR,CMRZ,ST,STA
|
|---|
| 20 | K J,JJ,PRCN,PRCNC,VEN,PRCNTDA,D1,PFL,QTY,RDA,RDI,TDA,EDIT
|
|---|
| 21 | Q
|
|---|
| 22 | LINE ; Display associated replacement line items
|
|---|
| 23 | S RDA=D0,RDI=D1,QTY=$P($G(^PRCN(413,RDA,1,RDI,0)),U,5)
|
|---|
| 24 | EN1 N DIEL,DG,DI,DK,DL,DM,DP,DU,D0,D1,DA,DIC,DIE,DR,DQ,X,Y,DV,DOV
|
|---|
| 25 | S DIC("S")="I $P(^(0),U,3)=RDI",DA(1)=TDA,DIC(0)="AEQZ",DIC("A")="Select Replacement Line Item: "
|
|---|
| 26 | S PRCNCMR=$P(^PRCN(413.1,TDA,0),U,16)
|
|---|
| 27 | S DIC="^PRCN(413.1,"_TDA_",1," D ^DIC Q:Y<1 S RI=$P(Y,U,2),DA=+Y D DISP^PRCNTIRQ K DIC("S")
|
|---|
| 28 | S DIE("NO^")=""
|
|---|
| 29 | S DR=".01;.5Replacement Justification~;I X'=6 S Y="""";.7",DIE=DIC D ^DIE
|
|---|
| 30 | D CT I NUM<QTY D
|
|---|
| 31 | . W !,"Number of replacement items does not equal quantity"
|
|---|
| 32 | . S NM=$P($G(^PRCN(413.1,TDA,1,0)),U,3)
|
|---|
| 33 | . I NM="" S ^PRCN(413.1,TDA,1,0)="^413.11IPA^^"
|
|---|
| 34 | . D RP2^PRCNREQN
|
|---|
| 35 | EXIT K TDA,RDA,RI,DA,DIE,DIC,DR
|
|---|
| 36 | Q
|
|---|
| 37 | CT S NUM=0,NN="" F S NN=$O(^PRCN(413.1,TDA,1,"AC",RDI,NN)) Q:NN="" S NUM=NUM+1
|
|---|
| 38 | Q
|
|---|
| 39 | TXT ; Set first 20 characters into Short Description field
|
|---|
| 40 | S $P(^PRCN(413,D0,0),U,18)=""
|
|---|
| 41 | S PRCNTXT=$G(^PRCN(413,D0,1,1,1,1,0))
|
|---|
| 42 | I $L(PRCNTXT)>20 S PRCNTXT=$E(PRCNTXT,1,20)
|
|---|
| 43 | S VEN=$P($G(^PRCN(413,D0,1,D1,0)),U,2) S:VEN'="" VEN=$P(^PRC(440,VEN,0),U)
|
|---|
| 44 | S VEN=$S($G(VEN)="":$P($G(^PRCN(413,D0,1,D1,0)),U,13),1:VEN)
|
|---|
| 45 | Q
|
|---|
| 46 | CMP ; Check for completeness of data
|
|---|
| 47 | S PFL=0
|
|---|
| 48 | S PDD1=D1 D CMPD Q:QFL
|
|---|
| 49 | S PDD1=0 F S PDD1=$O(^PRCN(413,D0,1,PDD1)) Q:'PDD1 D CMPD Q:QFL
|
|---|
| 50 | I $P(^PRCN(413,D0,0),U,9)'="R" S PFL=1
|
|---|
| 51 | Q
|
|---|
| 52 | CMPD S QFL=0
|
|---|
| 53 | Q:'$D(^PRCN(413,D0,1,PDD1))
|
|---|
| 54 | F I=1,4,5,12 I $P(^PRCN(413,D0,1,PDD1,0),U,I)="" S QFL=1 Q
|
|---|
| 55 | I $P(^PRCN(413,D0,1,PDD1,0),U,12)="P" S PFL=1
|
|---|
| 56 | Q
|
|---|
