| [613] | 1 | RMPFET9 ;DDC/KAW-DUPLICATE AN ORDER [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;; input: RMPFX,RMPFHAT
|
|---|
| 4 | ;;output: RMPFY1
|
|---|
| 5 | Q:'$D(^RMPF(791810,RMPFX,11)) S RMPFTF=$P(^(11),U,1) Q:RMPFTF'="B"
|
|---|
| 6 | N RMPFY D ARRAY^RMPFDT2
|
|---|
| 7 | S (X,CX)=0 F I=1:1 S X=$O(RMPFO(X)) Q:'X S CX=CX+1
|
|---|
| 8 | G END:CX'=1 K RMPFY1
|
|---|
| 9 | TWO W !!,"Will the second model be the same as the first? NO// "
|
|---|
| 10 | D READ G END:$D(RMPFOUT)
|
|---|
| 11 | TWO1 I $D(RMPFQUT) W !!,"Enter <Y> to order a second model that is the same as the first,",!,"<N> or <RETURN> to continue." G TWO
|
|---|
| 12 | G END:Y="" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G TWO1
|
|---|
| 13 | G END:"Nn"[Y S RMPFY=$O(RMPFO(0))
|
|---|
| 14 | I '$D(^RMPF(791810,RMPFX,101,RMPFY,0)) W $C(7),!!,"*** BAD ORDER INFORMATION ***" G END
|
|---|
| 15 | W !!,"Adding second model ..."
|
|---|
| 16 | S S0=^RMPF(791810,RMPFX,101,RMPFY,0)
|
|---|
| 17 | S RMPFIT=$P(S0,U,1),RMPFLR=$P(S0,U,4),RMPFCS=$P(S0,U,14)
|
|---|
| 18 | S RMPFBAT=$P(S0,U,2),RMPFID=$P(S0,U,8)
|
|---|
| 19 | I '$D(^RMPF(791810,RMPFX,101,0)) S ^RMPF(791810,RMPFX,101,0)="^791810.0101P"
|
|---|
| 20 | S DIC="^RMPF(791810,RMPFX,101,",DA(1)=RMPFX,DIC(0)="L",DLAYGO=791810
|
|---|
| 21 | S X="NOW",%DT="T" D ^%DT S TD=Y W "."
|
|---|
| 22 | S X=RMPFIT,DIC("DR")=".04////"_$S(RMPFLR="L":"R",1:"L")_";.14////"_RMPFCS_";.15////O"
|
|---|
| 23 | I RMPFHAT="S" S DIC("DR")=DIC("DR")_";.02////"_RMPFBAT_";.08////"_RMPFID_";.05;101"
|
|---|
| 24 | K DD,DO D FILE^DICN I Y=-Y W $C(7),!!,"*** MODEL NOT ADDED ***" G END
|
|---|
| 25 | S (DA,RMPFY1)=+Y,DIE=DIC,DR=".16////"_+Y_";.17////"_TD_";.18///INCOMPLETE;.19////O;.2////1" D ^DIE W "."
|
|---|
| 26 | W !!,"*** MODEL ADDED ***"
|
|---|
| 27 | D ARRAY2^RMPFDT2 S CM="",(X,CX)=0 F I=1:1 S X=$O(RMPFC(X)) Q:'X S CX=CX+1,C=$P(RMPFC(X),U,1) I C,$D(^RMPF(791811.2,C,0)) S CM=$S(I=1:$P(^(0),U,3),1:CM_","_$P(^(0),U,3))
|
|---|
| 28 | G END:'CX
|
|---|
| 29 | COM W !!,"The following components were ordered with the first model: ",CM
|
|---|
| 30 | W !!,"Do you wish to order the same components with the second model? NO// "
|
|---|
| 31 | D READ G END:$D(RMPFOUT)
|
|---|
| 32 | COM1 I $D(RMPFQUT) W !!,"Enter <Y> to order the same components for the second model",!,"<N> or <RETURN> to continue." G COM
|
|---|
| 33 | G COM3:Y="" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G COM1
|
|---|
| 34 | G COM3:"Nn"[Y S (RMPFZ,CT)=0 W !!,"Adding component(s) ..."
|
|---|
| 35 | COM2 S RMPFZ=$O(^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ)) G EXIT:'RMPFZ S S0=^(RMPFZ,0)
|
|---|
| 36 | S RMPFCOM=$P(S0,U,1),RMPFCX=$P(S0,U,2)
|
|---|
| 37 | I '$D(^RMPF(791810,RMPFX,101,RMPFY1,102,0)) S ^RMPF(791810,RMPFX,101,RMPFY1,102,0)="^791810.101102P"
|
|---|
| 38 | S DIC="^RMPF(791810,"_RMPFX_",101,"_RMPFY1_",102," W "."
|
|---|
| 39 | S DA(2)=RMPFX,DA(1)=RMPFY1,X=RMPFCOM,DIC(0)="L",DLAYGO=791810
|
|---|
| 40 | S DIC("DR")=".03////O;.05////"_DUZ_";.06////"_TD W "."
|
|---|
| 41 | K DO,DD D FILE^DICN I Y=-1 W $C(7),!!,"*** COMPONENT NOT ADDED ***" G END
|
|---|
| 42 | S $P(^RMPF(791810,RMPFX,101,RMPFY1,102,+Y,0),U,4)=+Y W "." S CT=CT+1
|
|---|
| 43 | G COM2
|
|---|
| 44 | COM3 S RMPFY=RMPFY1 D COMPON^RMPFET7 G END
|
|---|
| 45 | EXIT W !!,"*** COMPONENT" W:CT>1 "S" W " ADDED ***"
|
|---|
| 46 | END K %,%DT,C,CM,CT,CX,D0,DA,DI,DIC,DIE,DR,I,S0,TD,X,Y,ZZ,DQ,DLAYGO,RMPFC
|
|---|
| 47 | K RMPFCOM,RMPFCS,RMPFCX,RMPFIT,RMPFLR,RMPFO,RMPFTF,RMPFZ,RMPFID
|
|---|
| 48 | K RMPFOUT,RMPFQUT,RMPFBAT,M,ZY,%Y,RMPFRE,I,RMPFO,RMPFTF,X
|
|---|
| 49 | Q
|
|---|
| 50 | READ K RMPFOUT,RMPFQUT
|
|---|
| 51 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 52 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 53 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 54 | Q
|
|---|
