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