| 1 | PRCNCNCL ;SSI/SEB-Cancel equipment request ;[ 02/26/97 5:59 PM ]
|
---|
| 2 | ;;1.0;PRCN;**3**;Sep 13, 1996
|
---|
| 3 | REQ ; 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
|
---|
| 6 | PPM ; PPM cancel
|
---|
| 7 | S DIC("S")="S ST=$P(^(0),U,7) I (ST'=20&(ST'=34)&(ST'=35)&(ST'=36))"
|
---|
| 8 | Q
|
---|
| 9 | EN 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)
|
---|
| 12 | PR ; 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
|
---|
| 26 | ASK ; 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."
|
---|
| 38 | REP ; 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)
|
---|
| 41 | QS 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."
|
---|
| 50 | EXIT ; 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
|
---|