- 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 Jan 18, 2025@03:37:11 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