source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET83.m@ 975

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1RMPFET83 ;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
10NEW 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
45EXIT S RMPFX=RMPFX1,RMPFHAT=RMPFHAT1,RMPFST=RMPFST1,RMPFTYP=RMPFTYP1
46CANCELE 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
Note: See TracBrowser for help on using the repository browser.