49 lines
2.3 KiB
Mathematica
49 lines
2.3 KiB
Mathematica
RMPFET83 ;DDC/KAW-CONTINUATION OF RMPFET82 [ 06/16/95 3:06 PM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|
;;Get cancel reason and change status of line item for CHA order
|
|
;; input: RMPFX,RMPFY,RMPFHAT,RMPFTYP,RMPFST,DFN,RMPFCAN
|
|
;;output: None
|
|
Q:'$D(RMPFCAN)
|
|
S RMPFX1=RMPFX,RMPFHAT1=RMPFHAT,RMPFTYP1=RMPFTYP,RMPFST1=RMPFST
|
|
S RMPFTYP=9,RMPFHAT="U",X=$G(^RMPF(791810,RMPFX,2))
|
|
S RMPFTE=$P(X,U,2)_U_$P(X,U,4),RMPFST=2
|
|
NEW D AUTO^RMPFET1
|
|
S (C,PP)=0 F S PP=$O(RMPFCAN(PP)) Q:'PP D
|
|
.S C=C+1
|
|
.I '$D(^RMPF(791810,RMPFX,101,0)) S ^RMPF(791810,RMPFX,101,0)="^791810.0101P"
|
|
.S ^RMPF(791810,RMPFX,101,PP,0)=$P(^RMPF(791810,RMPFX1,101,PP,0),U,1,14)
|
|
.S %DT="T",X="NOW" D ^%DT S TD=Y
|
|
.S DIK="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DA=PP D IX1^DIK
|
|
.S RMPFIT=$P(^RMPF(791810,RMPFX,101,PP,0),U,1),RMPFQTY=$P(^(0),U,6)
|
|
.I RMPFIT,$D(^RMPF(791811,RMPFIT,0)) S RMPFIT=$P(^(0),U,1)
|
|
.W !!,"Item # ",C,": ",RMPFIT,?$X+5,RMPFQTY,!
|
|
.S DIE=DIK,DR=".15////O;.16////"_PP_";.17////"_TD_";.18////3;.19////O;.2////1;90.13////"_DUZ
|
|
.I $D(RMPFRE) S DR=DR_";90.05////"_RMPFRE_";90.06////"_RMPFRTC
|
|
.D ^DIE
|
|
.I RMPFHAT1="I" D
|
|
..S RMPFSN=$P(^RMPF(791810,RMPFX,101,PP,0),U,5)
|
|
..I RMPFSN'="" W !,"Serial Number: ",RMPFSN
|
|
..S DR="90.05;90.06" I RMPFSN="" S DR=".05;"_DR
|
|
..D ^DIE
|
|
.S S9=$G(^RMPF(791810,RMPFX,101,PP,90))
|
|
.S RMPFRE=$P(S9,U,5),RMPFRTC=$P(S9,U,6)
|
|
.S DIE="^RMPF(791810,"_RMPFX1_",101,",DA(1)=RMPFX1,DA=PP
|
|
.S DR=".15////C;.17////"_TD_";.18////11;.19////C;.2////1;.14///0;90.13///"_DUZ
|
|
.I "CI"[RMPFHAT1 S DR=DR_";90.05////"_RMPFRE_";90.06////"_RMPFRTC
|
|
.D ^DIE
|
|
S $P(^RMPF(791810,RMPFX,101,0),U,3)=PP,$P(^(0),U,4)=C
|
|
S PO=$P(^RMPF(791810,RMPFX1,0),U,7)
|
|
S DIE="^RMPF(791810,",DA=RMPFX W !
|
|
S DR=".08////"_DUZ_";.09////"_DT_";.07////"_PO_";10.01" D ^DIE
|
|
W !!,"Item",$S(C=1:"",1:"(s)")," CANCELED",!!
|
|
S RMPFHAT="U",X=$P(^RMPF(791810,RMPFX,0),U,2)
|
|
I X,$D(^RMPF(791810.1,X,0)) S RMPFHAT=$P(^(0),U,2)
|
|
D APPROV1^RMPFEA2
|
|
S Y=$O(^RMPF(791810.2,"C","APPROVED",0)) G EXIT:'Y
|
|
D ARRAY^RMPFDT2 S X=0
|
|
F S X=$O(RMPFO(X)) Q:'X I $D(^RMPF(791810,RMPFX,101,X,0)),$P(^(0),U,18)=Y S DIE="^RMPF(791810,",DA=RMPFX,DR=".03///APPROVED" D ^DIE Q
|
|
EXIT S RMPFX=RMPFX1,RMPFHAT=RMPFHAT1,RMPFST=RMPFST1,RMPFTYP=RMPFTYP1
|
|
CANCELE K DIE,DR,DA,X,D,D0,DI,DIC,DQ,%DT,RX,TD,ZY,ZZ,RMPFX1,RMPFY,RMPFSSN
|
|
K C,RMPFHAT1,PP,PO,RMPFSN,S9,RMPFRTC,RMPFRE,RMPFQTY,RMPFIT,RMPFCAN
|
|
K RMPFST1,RMPFTYP1,RMPFTE,ST,Y Q
|