| 1 | RMPFET83 ;DDC/KAW-CONTINUATION OF RMPFET82 [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;;Get cancel reason and change status of line item for CHA order
|
|---|
| 4 | ;; input: RMPFX,RMPFY,RMPFHAT,RMPFTYP,RMPFST,DFN,RMPFCAN
|
|---|
| 5 | ;;output: None
|
|---|
| 6 | Q:'$D(RMPFCAN)
|
|---|
| 7 | S RMPFX1=RMPFX,RMPFHAT1=RMPFHAT,RMPFTYP1=RMPFTYP,RMPFST1=RMPFST
|
|---|
| 8 | S RMPFTYP=9,RMPFHAT="U",X=$G(^RMPF(791810,RMPFX,2))
|
|---|
| 9 | S RMPFTE=$P(X,U,2)_U_$P(X,U,4),RMPFST=2
|
|---|
| 10 | NEW D AUTO^RMPFET1
|
|---|
| 11 | S (C,PP)=0 F S PP=$O(RMPFCAN(PP)) Q:'PP D
|
|---|
| 12 | .S C=C+1
|
|---|
| 13 | .I '$D(^RMPF(791810,RMPFX,101,0)) S ^RMPF(791810,RMPFX,101,0)="^791810.0101P"
|
|---|
| 14 | .S ^RMPF(791810,RMPFX,101,PP,0)=$P(^RMPF(791810,RMPFX1,101,PP,0),U,1,14)
|
|---|
| 15 | .S %DT="T",X="NOW" D ^%DT S TD=Y
|
|---|
| 16 | .S DIK="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DA=PP D IX1^DIK
|
|---|
| 17 | .S RMPFIT=$P(^RMPF(791810,RMPFX,101,PP,0),U,1),RMPFQTY=$P(^(0),U,6)
|
|---|
| 18 | .I RMPFIT,$D(^RMPF(791811,RMPFIT,0)) S RMPFIT=$P(^(0),U,1)
|
|---|
| 19 | .W !!,"Item # ",C,": ",RMPFIT,?$X+5,RMPFQTY,!
|
|---|
| 20 | .S DIE=DIK,DR=".15////O;.16////"_PP_";.17////"_TD_";.18////3;.19////O;.2////1;90.13////"_DUZ
|
|---|
| 21 | .I $D(RMPFRE) S DR=DR_";90.05////"_RMPFRE_";90.06////"_RMPFRTC
|
|---|
| 22 | .D ^DIE
|
|---|
| 23 | .I RMPFHAT1="I" D
|
|---|
| 24 | ..S RMPFSN=$P(^RMPF(791810,RMPFX,101,PP,0),U,5)
|
|---|
| 25 | ..I RMPFSN'="" W !,"Serial Number: ",RMPFSN
|
|---|
| 26 | ..S DR="90.05;90.06" I RMPFSN="" S DR=".05;"_DR
|
|---|
| 27 | ..D ^DIE
|
|---|
| 28 | .S S9=$G(^RMPF(791810,RMPFX,101,PP,90))
|
|---|
| 29 | .S RMPFRE=$P(S9,U,5),RMPFRTC=$P(S9,U,6)
|
|---|
| 30 | .S DIE="^RMPF(791810,"_RMPFX1_",101,",DA(1)=RMPFX1,DA=PP
|
|---|
| 31 | .S DR=".15////C;.17////"_TD_";.18////11;.19////C;.2////1;.14///0;90.13///"_DUZ
|
|---|
| 32 | .I "CI"[RMPFHAT1 S DR=DR_";90.05////"_RMPFRE_";90.06////"_RMPFRTC
|
|---|
| 33 | .D ^DIE
|
|---|
| 34 | S $P(^RMPF(791810,RMPFX,101,0),U,3)=PP,$P(^(0),U,4)=C
|
|---|
| 35 | S PO=$P(^RMPF(791810,RMPFX1,0),U,7)
|
|---|
| 36 | S DIE="^RMPF(791810,",DA=RMPFX W !
|
|---|
| 37 | S DR=".08////"_DUZ_";.09////"_DT_";.07////"_PO_";10.01" D ^DIE
|
|---|
| 38 | W !!,"Item",$S(C=1:"",1:"(s)")," CANCELED",!!
|
|---|
| 39 | S RMPFHAT="U",X=$P(^RMPF(791810,RMPFX,0),U,2)
|
|---|
| 40 | I X,$D(^RMPF(791810.1,X,0)) S RMPFHAT=$P(^(0),U,2)
|
|---|
| 41 | D APPROV1^RMPFEA2
|
|---|
| 42 | S Y=$O(^RMPF(791810.2,"C","APPROVED",0)) G EXIT:'Y
|
|---|
| 43 | D ARRAY^RMPFDT2 S X=0
|
|---|
| 44 | 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
|
|---|
| 45 | EXIT S RMPFX=RMPFX1,RMPFHAT=RMPFHAT1,RMPFST=RMPFST1,RMPFTYP=RMPFTYP1
|
|---|
| 46 | CANCELE K DIE,DR,DA,X,D,D0,DI,DIC,DQ,%DT,RX,TD,ZY,ZZ,RMPFX1,RMPFY,RMPFSSN
|
|---|
| 47 | K C,RMPFHAT1,PP,PO,RMPFSN,S9,RMPFRTC,RMPFRE,RMPFQTY,RMPFIT,RMPFCAN
|
|---|
| 48 | K RMPFST1,RMPFTYP1,RMPFTE,ST,Y Q
|
|---|
