| 1 | RMPFET61 ;DDC/KAW-EVALUATE LINE ITEM STATUS [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;; input: RMPFX,RMPFY,RMPFTYP,RMPFSTR0,RMPFSTR2,RMPFSTR3
|
|---|
| 4 | ;;output: RMPFERR
|
|---|
| 5 | Q:'$D(^RMPF(791810,RMPFX,101,RMPFY,0))
|
|---|
| 6 | K RMPFEDIT,RMPFERR S RMPFSTP=""
|
|---|
| 7 | S X=$P(^RMPF(791810,RMPFX,101,RMPFY,0),U,18)
|
|---|
| 8 | I X,$D(^RMPF(791810.2,X,0)) S RMPFSTP=$P(^(0),U,2)
|
|---|
| 9 | F I=4,8,9,10:1:16 I X=I G END
|
|---|
| 10 | S:RMPFSTP="" RMPFSTP="I" I RMPFSTP="I" S RMPFEDIT=""
|
|---|
| 11 | F I=0,2,3 S X=$G(^RMPF(791810,RMPFX,101,RMPFY,I)) I X'=@("RMPFSTR"_I) S RMPFEDIT="" Q
|
|---|
| 12 | G END:'$D(RMPFEDIT)
|
|---|
| 13 | CK2 S ST="" I $D(^RMPF(791810.1,RMPFTYP,2)) S ST=$P(^(2),U,1) I ST'="" D
|
|---|
| 14 | .Q:'$D(^RMPF(791810,RMPFX,101,RMPFY,0))
|
|---|
| 15 | .F J=1:1 S D=$P(ST,";",J) Q:D="" D Q:D=9999
|
|---|
| 16 | ..I D?1"I ".E X D Q:'$T S D=9999 Q
|
|---|
| 17 | ..S ND=$$GET1^DID(791810.0101,D,"","GLOBAL SUBSCRIPT LOCATION") S A=$P(ND,U,4),B=$P(A,";",1),C=$P(A,";",2) Q:B=""!(C="")
|
|---|
| 18 | ..I $D(^RMPF(791810,RMPFX,101,RMPFY,B)),C=0,$O(^RMPF(791810,RMPFX,101,RMPFY,B,0)) Q
|
|---|
| 19 | ..I $D(^RMPF(791810,RMPFX,101,RMPFY,B)),C'=0,$P(^RMPF(791810,RMPFX,101,RMPFY,B),U,C)'="" Q
|
|---|
| 20 | ..S E=$$GET1^DID(791810.0101,D,"","LABEL") S:E'="" RMPFERR(E)=""
|
|---|
| 21 | I ST[".01",'$O(^RMPF(791810,RMPFX,101,0)) S RMPFERR("NO ITEM SELECTED")=""
|
|---|
| 22 | S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DA=RMPFY
|
|---|
| 23 | I RMPFTYP'=5 S S=$S('$D(RMPFERR):"PENDING",1:"INCOMPLETE")
|
|---|
| 24 | E S S=$S('$D(RMPFERR):"ISSUE DATE PENDING",1:"ERROR")
|
|---|
| 25 | S %DT="T",X="NOW" D ^%DT
|
|---|
| 26 | S DR=".17////"_Y_";.18///"_S_";.2////1"
|
|---|
| 27 | I $D(RMPFLA) S DR=DR_";.19////"_RMPFLA
|
|---|
| 28 | D ^DIE
|
|---|
| 29 | END K RMPFSTP,RMPFSTR0,RMPFSTR2,RMPFSTR3,I,J,X,ST,RMPFEDIT,%DT,A,B,C,D,S
|
|---|
| 30 | K D0,DA,DI,DIC,DIE,DQ,DR,RMPFLA Q
|
|---|
| 31 | PRIOR ;;Record data strings prior to editing
|
|---|
| 32 | ;; input: RMPFX,RMPFY
|
|---|
| 33 | ;;output: RMPFSTR0,RMPFSTR2,RMPFSTR3
|
|---|
| 34 | F I=0,2,3 S @("RMPFSTR"_I)=$G(^RMPF(791810,RMPFX,101,RMPFY,I))
|
|---|
| 35 | K I Q
|
|---|
| 36 | CLEAR ;;Clear errors and disapprovals by line item
|
|---|
| 37 | ;; input: RMPFX,RMPFY,RMPFSTO
|
|---|
| 38 | ;;output: None
|
|---|
| 39 | W !!,"The status of this line item order is "
|
|---|
| 40 | W $P(^RMPF(791810.2,$P(^RMPF(791810,RMPFX,101,RMPFY,0),U,18),0),U,1)
|
|---|
| 41 | CL1 W !!,"Do you wish to clear this status and edit the order? NO// "
|
|---|
| 42 | D READ Q:$D(RMPFOUT)
|
|---|
| 43 | CL11 I $D(RMPFQUT) W !!,"Enter a <Y> to clear the status and edit the order",!?5,"an <N> to leave the status as it is" G CL1
|
|---|
| 44 | S YX=Y S:YX="" YX="N" S YX=$E(YX,1) I "NnYy"'[YX S RMPFQUT="" G CL11
|
|---|
| 45 | I "Nn"[YX K RMPFSTO G CLEARE
|
|---|
| 46 | S %DT="T",X="NOW" D ^%DT
|
|---|
| 47 | S ST=$S(RMPFSTO="S":"ISSUE DATE PENDING",1:"INCOMPLETE")
|
|---|
| 48 | S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DA=RMPFY
|
|---|
| 49 | S DR=".17////"_Y_";.18///"_ST_";.19////O;.2////1" D ^DIE
|
|---|
| 50 | CLEARE K X,Y,YX,%DT,D0,DA,DI,DIC,DIE,DQ,DR,ST Q
|
|---|
| 51 | READ K RMPFOUT,RMPFQUT
|
|---|
| 52 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 53 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 54 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 55 | Q
|
|---|
