source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNCNCL.m@ 949

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PRCNCNCL ;SSI/SEB-Cancel equipment request ;[ 02/26/97 5:59 PM ]
2 ;;1.0;PRCN;**3**;Sep 13, 1996
3REQ ; Requestor cancel
4 S DIC("S")="S ST=$P(^(0),U,7) I $P(^(0),U,2)=DUZ&(ST=4!(ST=11)!(ST=12)!(ST=14)!(ST=15)!(ST=16)!(ST=1))"
5 Q
6PPM ; PPM cancel
7 S DIC("S")="S ST=$P(^(0),U,7) I (ST'=20&(ST'=34)&(ST'=35)&(ST'=36))"
8 Q
9EN W @IOF S DIC("A")="Enter TRANSACTION #: ",DIC="^PRCN(413,",DIC(0)="AEQ"
10 D ^DIC K DIC("S")
11 G:$D(DUOUT)!(X="") EXIT S D0=+Y,PRCNDATA=^PRCN(413,D0,0),NUM=$P(Y,U,2)
12PR ; Prints the data for this transaction
13 W !!,"Service: ",$P(^DIC(49,$P(PRCNDATA,U,3),0),U),?41,"CMR Official: "
14 I $P(PRCNDATA,U,6)'="" W $P(^VA(200,$P(PRCNDATA,U,6),0),U)
15 W !,"Requestor: ",$P(^VA(200,$P(PRCNDATA,U,2),0),U)
16 W ?41,"Date entered: " S Y=$P(PRCNDATA,U,4)\1
17 D DD^%DT W Y,!,"Line Items:" S D1=0
18 F S D1=$O(^PRCN(413,D0,1,D1)) Q:D1'?1N.N D
19 . W !,?5,$P($G(^PRCN(413,D0,1,D1,0)),U),?10,$G(^PRCN(413,D0,1,D1,1,1,0))
20 . S DR=15,DR(413.015)=6,DIQ(0)="C",DIQ="LBTOT"
21 . S DIC=413,DA=D0,DA(1)=D1,DA(413.015)=D1 NEW D1,D0
22 . D EN^DIQ1
23 . S X=$G(LBTOT(413.015,DA(413.015),6))
24 . W ?55,"$",$J(X,9,2)
25 . K DIQ,DA,DR,DIC,X,LBTOT
26ASK ; Ask if user is certain he/she wants to cancel request
27 W !!,"Are you sure you want to cancel this transaction" S %=2 D YN^DICN
28 I %=0 W !,"Please enter 'Y' to cancel this transaction." G ASK
29 I %'=1 W !!,"OK, the transaction was not cancelled." G EXIT:%=-1,REP
30 S DR="127;I '$D(^PRCN(413,D0,37)) W $C(7),""?? Reason for cancellation is required!"" S Y=127;6////^S X=20;7////^S X=DT;49///@"
31 S DIE=413,DA=D0 D ^DIE
32 S X=$P($G(^PRCN(413,DA,2)),U,18) D
33 . D:'$D(PSER) PRIMAX^PRCNCMRP
34 . S RNK="" F S RNK=$O(^PRCN(413,"P",PSER,RNK)) Q:RNK="" K ^PRCN(413,"P",PSER,RNK,DA)
35 . K PSER,X,RNK
36 S $P(^PRCN(413,DA,2),U,18)=""
37 W !!,"Transaction #",NUM," has been cancelled."
38REP ; If replacement, ask if user wants to cancel turn-in
39 G EXIT:$P(^PRCN(413,D0,0),U,9)'="R"
40 S DA=$P(^PRCN(413,D0,0),U,11)
41QS W !!,"Do you want to cancel the corresponding turn-in request" S %=2
42 D YN^DICN I %=2 W !!,"OK, the turn-in request was not cancelled." G EXIT
43 I %=0 W !,"Please enter 'Y' to cancel the corresponding Turn-in request." G QS
44 S DIE=413.1,DR="6////^S X=20;7////^S X=DT" D ^DIE
45 ; Remove associated items from Equip Inv file 6914
46 S D1=0 F S D1=$O(^PRCN(413.1,DA,1,D1)) Q:'D1 D
47 . S PTR=$P(^PRCN(413.1,DA,1,D1,0),U)
48 . K ^PRCN(413.1,"AB",PTR,DA,D1)
49 W !!,"Turn-in request #",$P(^PRCN(413.1,DA,0),U)," cancelled."
50EXIT ; Kill variables and quit
51 K X,Y,ST,TRN,NUM,C,PRCNDATA,D1,PTR,DA,DIE,DIC,SERV,OLD,PRIMAX,PSER
52 K D0,J,LPRI,OLDPRI,SK,DR,TEX1,TEX2,TEX3
53 Q
Note: See TracBrowser for help on using the repository browser.