RMPFEA1 ;DDC/KAW-APPROVE/DISAPPROVE ORDERS; [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
SEL ;;input: RMPFS
;;output: RMPFX,RMPFM
K RMPFX S RMPFM="I" S XX=$P(RMPFSYS,U,6)
G SELE:'$D(RMPFS)
SEL1 W !!,"Select an order number" I XX W ", <M>ultiple Approval"
W " or <RETURN> to exit: " D READ G END:$D(RMPFOUT)
SEL11 I $D(RMPFQUT) W !!,"Enter the number to the left of the order you wish to approve",!,"<RETURN> to continue." W:XX " Enter an <M> to approve multiple orders." G SEL1
G SELE:Y="" I XX,"Mm"[Y S RMPFM="M" G SELE
I '$D(RMPFS(Y)) S RMPFQUT="" G SEL11
SEL2 S RMPFX=RMPFS(Y)
SELE K XX,Y Q
MULTI ;;input: RMPFM
;;output:
G END:RMPFM'="M"
W !!,"Approve <A>ll orders, by <O>rdering Official, <T>ype of Order or",!,"Numbers of specific orders separated by commas. O// "
D READ G END:$D(RMPFOUT)
MULTI1 I $D(RMPFQUT) D MSG G MULTI
S:Y="" Y="O" I "AaOoTt"'[Y&(Y'?1N.E) S RMPFQUT="" G MULTI1
I Y?1N.E K RMPFS1 S CT=0 D SUB G MULTI1:$D(RMPFQUT),EXIT
S Y=$E(Y,1),OR=$S("Aa"[Y:"A","Oo"[Y:"O",1:"T")
D ORD:OR="O",TYP:OR="T" G END:Y=-1
S (CT,RMPFX)=0
F IK=1:1 S RMPFX=$O(^RMPF(791810,"AC",2,RMPFX)) Q:'RMPFX S S0=$G(^RMPF(791810,RMPFX,0)) I $P(S0,U,15)=$O(^RMPF(791810.5,"C",RMPFMENU,0)),$P(S0,U,3)=2 D SUB1
EXIT W !!,CT," Orders Added to the Batch." D CONT^RMPFEA
END K JJ,KK,IK,OR,CT,Y,RMPFX,RMPFM,DI,I,DIE,DR,D0,DI,D,% Q
SUB F KK=1:1 S JJ=$P(Y,",",KK) Q:JJ="" D Q:$D(RMPFQUT)
.I '$D(RMPFS(JJ)) S RMPFQUT="" Q
.S RMPFS1(RMPFS(JJ))=""
S RMPFX=0 F S RMPFX=$O(RMPFS1(RMPFX)) Q:'RMPFX D
.Q:'$D(^RMPF(791810,RMPFX,0)) S RMPFHAT="",X=$P(^(0),U,2)
.I X,$D(^RMPF(791810.1,X,0)) S RMPFHAT=$P(^(0),U,2)
.D SET^RMPFEA2 S CT=CT+1
Q
SUB1 Q:'$D(^RMPF(791810,RMPFX,0)) S S0=^(0),X=$P(S0,U,2),RMPFHAT=""
I X,$D(^RMPF(791810.1,X,0)) S RMPFHAT=$P(^(0),U,2)
I OR="O" Q:$P(S0,U,8)'=RMPFAD
I OR="T" Q:$P(S0,U,2)'=RMPFTYP
D SET^RMPFEA2 S CT=CT+1
Q
ORD S DIC=200,DIC(0)="AEQM" D ^DIC Q:Y=-1 S RMPFAD=+Y Q
TYP S DIC=791810.1,DIC(0)="AEQM",DIC("S")="I '$P(^(0),U,7)"
D ^DIC K DIC Q:Y=-1 S RMPFTYP=+Y 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
MSG W !!,"Enter an <A> to approve all pending orders"
W !?6,"an <O> or <RETURN> to approve orders for one Ordering Official"
W !?7,"a <T> to approve orders of one specific type"
W !?6,"The numbers to the left of orders, separated by commas for specific orders"
W !?6,"an <^> to exit." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFEA1 2522 printed Sep 23, 2025@20:12:23 Page 2
RMPFEA1 ;DDC/KAW-APPROVE/DISAPPROVE ORDERS; [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
SEL ;;input: RMPFS
+1 ;;output: RMPFX,RMPFM
+2 KILL RMPFX
SET RMPFM="I"
SET XX=$PIECE(RMPFSYS,U,6)
+3 if '$DATA(RMPFS)
GOTO SELE
SEL1 WRITE !!,"Select an order number"
IF XX
WRITE ", <M>ultiple Approval"
+1 WRITE " or <RETURN> to exit: "
DO READ
if $DATA(RMPFOUT)
GOTO END
SEL11 IF $DATA(RMPFQUT)
WRITE !!,"Enter the number to the left of the order you wish to approve",!,"<RETURN> to continue."
if XX
WRITE " Enter an <M> to approve multiple orders."
GOTO SEL1
+1 if Y=""
GOTO SELE
IF XX
IF "Mm"[Y
SET RMPFM="M"
GOTO SELE
+2 IF '$DATA(RMPFS(Y))
SET RMPFQUT=""
GOTO SEL11
SEL2 SET RMPFX=RMPFS(Y)
SELE KILL XX,Y
QUIT
MULTI ;;input: RMPFM
+1 ;;output:
+2 if RMPFM'="M"
GOTO END
+3 WRITE !!,"Approve <A>ll orders, by <O>rdering Official, <T>ype of Order or",!,"Numbers of specific orders separated by commas. O// "
+4 DO READ
if $DATA(RMPFOUT)
GOTO END
MULTI1 IF $DATA(RMPFQUT)
DO MSG
GOTO MULTI
+1 if Y=""
SET Y="O"
IF "AaOoTt"'[Y&(Y'?1N.E)
SET RMPFQUT=""
GOTO MULTI1
+2 IF Y?1N.E
KILL RMPFS1
SET CT=0
DO SUB
if $DATA(RMPFQUT)
GOTO MULTI1
GOTO EXIT
+3 SET Y=$EXTRACT(Y,1)
SET OR=$SELECT("Aa"[Y:"A","Oo"[Y:"O",1:"T")
+4 if OR="O"
DO ORD
if OR="T"
DO TYP
if Y=-1
GOTO END
+5 SET (CT,RMPFX)=0
+6 FOR IK=1:1
SET RMPFX=$ORDER(^RMPF(791810,"AC",2,RMPFX))
if 'RMPFX
QUIT
SET S0=$GET(^RMPF(791810,RMPFX,0))
IF $PIECE(S0,U,15)=$ORDER(^RMPF(791810.5,"C",RMPFMENU,0))
IF $PIECE(S0,U,3)=2
DO SUB1
EXIT WRITE !!,CT," Orders Added to the Batch."
DO CONT^RMPFEA
END KILL JJ,KK,IK,OR,CT,Y,RMPFX,RMPFM,DI,I,DIE,DR,D0,DI,D,%
QUIT
SUB FOR KK=1:1
SET JJ=$PIECE(Y,",",KK)
if JJ=""
QUIT
Begin DoDot:1
+1 IF '$DATA(RMPFS(JJ))
SET RMPFQUT=""
QUIT
+2 SET RMPFS1(RMPFS(JJ))=""
End DoDot:1
if $DATA(RMPFQUT)
QUIT
+3 SET RMPFX=0
FOR
SET RMPFX=$ORDER(RMPFS1(RMPFX))
if 'RMPFX
QUIT
Begin DoDot:1
+4 if '$DATA(^RMPF(791810,RMPFX,0))
QUIT
SET RMPFHAT=""
SET X=$PIECE(^(0),U,2)
+5 IF X
IF $DATA(^RMPF(791810.1,X,0))
SET RMPFHAT=$PIECE(^(0),U,2)
+6 DO SET^RMPFEA2
SET CT=CT+1
End DoDot:1
+7 QUIT
SUB1 if '$DATA(^RMPF(791810,RMPFX,0))
QUIT
SET S0=^(0)
SET X=$PIECE(S0,U,2)
SET RMPFHAT=""
+1 IF X
IF $DATA(^RMPF(791810.1,X,0))
SET RMPFHAT=$PIECE(^(0),U,2)
+2 IF OR="O"
if $PIECE(S0,U,8)'=RMPFAD
QUIT
+3 IF OR="T"
if $PIECE(S0,U,2)'=RMPFTYP
QUIT
+4 DO SET^RMPFEA2
SET CT=CT+1
+5 QUIT
ORD SET DIC=200
SET DIC(0)="AEQM"
DO ^DIC
if Y=-1
QUIT
SET RMPFAD=+Y
QUIT
TYP SET DIC=791810.1
SET DIC(0)="AEQM"
SET DIC("S")="I '$P(^(0),U,7)"
+1 DO ^DIC
KILL DIC
if Y=-1
QUIT
SET RMPFTYP=+Y
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
MSG WRITE !!,"Enter an <A> to approve all pending orders"
+1 WRITE !?6,"an <O> or <RETURN> to approve orders for one Ordering Official"
+2 WRITE !?7,"a <T> to approve orders of one specific type"
+3 WRITE !?6,"The numbers to the left of orders, separated by commas for specific orders"
+4 WRITE !?6,"an <^> to exit."
QUIT
