source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFQI.m@ 738

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1RMPFQI ;DDC/KAW-PRINT PRODUCT LIST [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
4 I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
5 W @IOF,!,"PRINT PRODUCT LIST"
6 S MU=$O(^RMPF(791810.5,"C",RMPFMENU,0))
7A1 W !!,"Select <A>ll or <I>ndividual Product Groups: "
8 D READ G END:$D(RMPFOUT)
9A11 I $D(RMPFQUT) W !!,"Enter an <A> to print all product groups or",!?6,"an <I> to select an individual product group." G A1
10 G END:Y="" S Y=$E(Y,1) I "IiAa"'[Y S RMPFQUT="" G A1
11 I "Aa"[Y S (RMPFPG,RMPFIT)="*" G QUE
12A2 W !! S DIC=791811.1,DIC(0)="AEQM"
13 S DIC("S")="I $D(^RMPF(791811.1,+Y,101,""B"",MU))"
14 D ^DIC K DIC G A1:Y=-1
15 S RMPFPG=+Y
16ITEM W !!,"Print <A>ll items or an <I>ndividual item? A// "
17 D READ G END:$D(RMPFOUT)
18ITEM1 I $D(RMPFQUT) W !!,"Enter an <A> to print all items in the product group or",!?6,"an <I> to select an individual item." G ITEM
19 S:Y="" Y="A" S Y=$E(Y,1) I "AaIi"'[Y S RMPFQUT="" G ITEM1
20 I "Aa"[Y S RMPFIT="*" G QUE
21I1 W !! S DIC=791811,DIC(0)="AEQM",DIC("S")="I '$P($G(^RMPF(791811,Y,""I"")),U,1)" D ^DIC G ITEM:Y=-1 S RMPFIT=+Y
22QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
23 I IO=IO(0),'$D(IO("S")) D ^RMPFQIP G END:$D(RMPFOUT),A1
24 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFQIP
25 S ZTRTN="^RMPFQIP",ZTDESC="PRODUCT PRINT",ZTIO=ION,ZTSAVE("RM*")=""
26 D ^%ZTLOAD,HOME^%ZIS
27 W:$D(ZTSK) !!,"*** Request Queued ***" H 2 G RMPFSET
28END K X,Y,DIC,RMPFPG,RMPFIT,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,MU,%XX,%YY
29 K RMPFOUT,RMPFQUT,DISYS,POP,%,%T Q
30READ K RMPFOUT,RMPFQUT
31 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
32 I Y?1"^".E S (RMPFOUT,Y)="" Q
33 S:Y?1"?".E (RMPFQUT,Y)=""
34 Q
Note: See TracBrowser for help on using the repository browser.