RMPFQI ;DDC/KAW-PRINT PRODUCT LIST [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
W @IOF,!,"PRINT PRODUCT LIST"
S MU=$O(^RMPF(791810.5,"C",RMPFMENU,0))
A1 W !!,"Select <A>ll or <I>ndividual Product Groups: "
D READ G END:$D(RMPFOUT)
A11 I $D(RMPFQUT) W !!,"Enter an <A> to print all product groups or",!?6,"an <I> to select an individual product group." G A1
G END:Y="" S Y=$E(Y,1) I "IiAa"'[Y S RMPFQUT="" G A1
I "Aa"[Y S (RMPFPG,RMPFIT)="*" G QUE
A2 W !! S DIC=791811.1,DIC(0)="AEQM"
S DIC("S")="I $D(^RMPF(791811.1,+Y,101,""B"",MU))"
D ^DIC K DIC G A1:Y=-1
S RMPFPG=+Y
ITEM W !!,"Print <A>ll items or an <I>ndividual item? A// "
D READ G END:$D(RMPFOUT)
ITEM1 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
S:Y="" Y="A" S Y=$E(Y,1) I "AaIi"'[Y S RMPFQUT="" G ITEM1
I "Aa"[Y S RMPFIT="*" G QUE
I1 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
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
I IO=IO(0),'$D(IO("S")) D ^RMPFQIP G END:$D(RMPFOUT),A1
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFQIP
S ZTRTN="^RMPFQIP",ZTDESC="PRODUCT PRINT",ZTIO=ION,ZTSAVE("RM*")=""
D ^%ZTLOAD,HOME^%ZIS
W:$D(ZTSK) !!,"*** Request Queued ***" H 2 G RMPFSET
END K X,Y,DIC,RMPFPG,RMPFIT,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,MU,%XX,%YY
K RMPFOUT,RMPFQUT,DISYS,POP,%,%T Q
READ K RMPFOUT,RMPFQUT
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
I Y?1"^".E S (RMPFOUT,Y)="" Q
S:Y?1"?".E (RMPFQUT,Y)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFQI 1826 printed Apr 09, 2024@21:39:36 Page 2
RMPFQI ;DDC/KAW-PRINT PRODUCT LIST [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
RMPFSET ;;RMPFMENU must be defined
IF '$DATA(RMPFMENU)
DO MENU^RMPFUTL
IF '$DATA(RMPFMENU)
WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
QUIT
+1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
DO ^RMPFUTL
if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
QUIT
+2 WRITE @IOF,!,"PRINT PRODUCT LIST"
+3 SET MU=$ORDER(^RMPF(791810.5,"C",RMPFMENU,0))
A1 WRITE !!,"Select <A>ll or <I>ndividual Product Groups: "
+1 DO READ
if $DATA(RMPFOUT)
GOTO END
A11 IF $DATA(RMPFQUT)
WRITE !!,"Enter an <A> to print all product groups or",!?6,"an <I> to select an individual product group."
GOTO A1
+1 if Y=""
GOTO END
SET Y=$EXTRACT(Y,1)
IF "IiAa"'[Y
SET RMPFQUT=""
GOTO A1
+2 IF "Aa"[Y
SET (RMPFPG,RMPFIT)="*"
GOTO QUE
A2 WRITE !!
SET DIC=791811.1
SET DIC(0)="AEQM"
+1 SET DIC("S")="I $D(^RMPF(791811.1,+Y,101,""B"",MU))"
+2 DO ^DIC
KILL DIC
if Y=-1
GOTO A1
+3 SET RMPFPG=+Y
ITEM WRITE !!,"Print <A>ll items or an <I>ndividual item? A// "
+1 DO READ
if $DATA(RMPFOUT)
GOTO END
ITEM1 IF $DATA(RMPFQUT)
WRITE !!,"Enter an <A> to print all items in the product group or",!?6,"an <I> to select an individual item."
GOTO ITEM
+1 if Y=""
SET Y="A"
SET Y=$EXTRACT(Y,1)
IF "AaIi"'[Y
SET RMPFQUT=""
GOTO ITEM1
+2 IF "Aa"[Y
SET RMPFIT="*"
GOTO QUE
I1 WRITE !!
SET DIC=791811
SET DIC(0)="AEQM"
SET DIC("S")="I '$P($G(^RMPF(791811,Y,""I"")),U,1)"
DO ^DIC
if Y=-1
GOTO ITEM
SET RMPFIT=+Y
QUE WRITE !
SET %ZIS="NPQ"
DO ^%ZIS
if POP
GOTO END
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
DO ^RMPFQIP
if $DATA(RMPFOUT)
GOTO END
GOTO A1
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFQIP
+3 SET ZTRTN="^RMPFQIP"
SET ZTDESC="PRODUCT PRINT"
SET ZTIO=ION
SET ZTSAVE("RM*")=""
+4 DO ^%ZTLOAD
DO HOME^%ZIS
+5 if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 2
GOTO RMPFSET
END KILL X,Y,DIC,RMPFPG,RMPFIT,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,MU,%XX,%YY
+1 KILL RMPFOUT,RMPFQUT,DISYS,POP,%,%T
QUIT
READ KILL RMPFOUT,RMPFQUT
+1 READ Y:DTIME
IF '$TEST
WRITE $CHAR(7)
READ Y:5
if Y="."
GOTO READ
if '$TEST
SET Y=U
+2 IF Y?1"^".E
SET (RMPFOUT,Y)=""
QUIT
+3 if Y?1"?".E
SET (RMPFQUT,Y)=""
+4 QUIT
