source: FOIAVistA/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNREQE.m@ 1267

Last change on this file since 1267 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.5 KB
Line 
1PRCNREQE ;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
3EN 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)
10EDIT ; 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
19EQ 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
22LINE ; Display associated replacement line items
23 S RDA=D0,RDI=D1,QTY=$P($G(^PRCN(413,RDA,1,RDI,0)),U,5)
24EN1 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
35EXIT K TDA,RDA,RI,DA,DIE,DIC,DR
36 Q
37CT S NUM=0,NN="" F S NN=$O(^PRCN(413.1,TDA,1,"AC",RDI,NN)) Q:NN="" S NUM=NUM+1
38 Q
39TXT ; 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
46CMP ; 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
52CMPD 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
Note: See TracBrowser for help on using the repository browser.