source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFEP.m@ 847

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

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1RMPFEP ;DDC/KAW-ENTER/EDIT PRODUCTS FOR ASPS [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3 W @IOF,!,"PRODUCT, COMPONENT & BATTERY ENTER/EDIT"
4 W !!,"*** USE THIS OPTION WITH CAUTION ***"
5 W !!!,"Products, components and batteries must be entered or edited ONLY"
6 W !,"as directed by the DDC."
7 W !!,"If entries vary in any way (even by one character) from the entry in the DDC",!,"file, all orders for which this entry is chosen will be rejected."
8A1 W !!,"Edit <P>roduct, <C>omponent or <B>attery File? " D READ G END:$D(RMPFOUT)
9A11 I $D(RMPFQUT) W !!,"Enter a <P> to edit the Product File",!?6,"a <C> to edit the Component File or",!?6,"a <B> to edit the Battery File" G A1
10 G END:Y="" S Y=$E(Y,1) I "PpCcBb"'[Y S RMPFQUT="" G A11
11 S RMPFSEL=$S("Pp"[Y:"P","Bb"[Y:"B",1:"C")
12 D PRODUCT:RMPFSEL="P",COMPON:RMPFSEL="C",BATTERY:RMPFSEL="B"
13 G RMPFEP
14END K DIC,DIE,DR,DA,DI,DISYS,D1,D0,DLAYGO,DQ,%,RMPFSEL,X,Y Q
15PRODUCT W @IOF,!!,"ENTER/EDIT PRODUCTS"
16 W !!,"If you are entering a product that has components or batteries"
17 W !,"the components and batteries must be entered into the Component File and"
18 W !,"Battery File before they can be chosen through this option."
19 W !!,"ONLY enter components and batteries for a product if they are DDC approved."
20P1 W !! S DIC=791811,DIC(0)="AEQML",DLAYGO=791811 D ^DIC Q:Y=-1
21 S DIE=791811,DA=+Y
22 S DR=".01;.02;.03;.04;.05;.06////9;.07;.08;101;102"
23 D ^DIE
24 K DIC,DIE,DD,DO G P1
25COMPON W @IOF,!,"ENTER/EDIT COMPONENTS"
26 W !!,"ONLY enter components that are currently on contract."
27C1 W !! S DIC=791811.2,DIC(0)="AEQML",DLAYGO=791811.2 D ^DIC Q:Y=-1
28 W !! S DIE=DIC,DA=+Y,DR=".01;.03" D ^DIE
29 K DIC,DIE,DD,DO G C1
30BATTERY W @IOF,!,"ENTER/EDIT BATTERIES"
31 W !!,"ONLY enter batteries that are distributed by the DDC."
32B1 W !! S DIC=791811.3,DIC(0)="AEQML",DLAYGO=791811.3 D ^DIC Q:Y=-1
33 K DIC,DIE,DO,DD G B1
34READ K RMPFOUT,RMPFQUT
35 R Y:DTIME I '$T W *7 R Y:5 G READ:Y="." S:'$T Y=U
36 I Y?1"^".E S (RMPFOUT,Y)="" Q
37 S:Y?1"?".E (RMPFQUT,Y)=""
38 Q
Note: See TracBrowser for help on using the repository browser.