RMPFEV ;DDC/KAW-REMOTE ORDER/ENTRY PARAMETERS FOR ASPS; [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
RMPFSET S RMPFMENU=0 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 H 2
;; input: RMPFMENU
;;output: RMPFSYS
W @IOF,!,"REMOTE ORDER/ENTRY PARAMETERS FOR ASPS",!!
S DIC=4,DIC(0)="AEQM"
I $D(RMPFSTAP) S:RMPFSTAP'="" DIC("B")=$P(RMPFSTAP," - ",2)
D ^DIC G END:Y=-1
S (DA,RMPFSTAN)=+Y S RMPFSTAP=$S($D(^DIC(4,RMPFSTAN,99)):$P(^(99),U,1),1:"") S:RMPFSTAP'="" RMPFSTAP=RMPFSTAP_" - " S RMPFSTAP=RMPFSTAP_$P(Y,U,2)
PARAM I $D(RMPFSTAN),RMPFSTAN,$D(^RMPF(791813,RMPFSTAN,0)) G SET
A1 W !!,"Do You Wish to Add Parameters for this station? NO// "
D READ G END:$D(RMPFOUT)
A11 I $D(RMPFQUT) W !!,"Enter <Y> to add parameters for this station,",!?6,"<N> or <RETURN> to exit." G A1
S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G A11
G END:"Nn"[Y
S DLAYGO=791813,DIC(0)="L",DIC="^RMPF(791813,",DINUM=RMPFSTAN
S X=RMPFSTAN K DD,DO D FILE^DICN S DA=+Y
I Y=-1 W !!,"*** UNABLE TO ADD STATION TO PARAMETER FILE ***" G END
SET S X=$G(^RMPF(791813,DA,2)) I $P(X,U,3) D
.S A=$P(X,U,3) Q:'A Q:'$D(^VA(200,A,0)) S A=$P(^(0),U,1)
.S Y=$P(X,U,4) D DD^%DT
.W !!?1,"Last User to Run Purge: ",A,!,"Last Date Purge was Run: ",Y,!!
S DIE="^RMPF(791813,"
S DR=".02;.03;I X'=""S""&(X'=""A"") S Y=.05;.04;.05;.06;.07;.11;.12;.09;.13;.1;1.01;1.02;1.03;1.04;1.05;1.06;2.01;2.02"
D ^DIE,PARAM^RMPFUTL
END K %,%DT,%Y,POP,D,C,I,X,D0,DA,DI,DQ,DR,DDH,DZ,DIC,DIE,DISYS,DLAYGO,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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFEV 1766 printed Apr 09, 2024@21:39:42 Page 2
RMPFEV ;DDC/KAW-REMOTE ORDER/ENTRY PARAMETERS FOR ASPS; [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
RMPFSET ;;RMPFMENU must be defined
SET RMPFMENU=0
IF '$DATA(RMPFMENU)
WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
QUIT
+1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
DO ^RMPFUTL
HANG 2
+2 ;; input: RMPFMENU
+3 ;;output: RMPFSYS
+4 WRITE @IOF,!,"REMOTE ORDER/ENTRY PARAMETERS FOR ASPS",!!
+5 SET DIC=4
SET DIC(0)="AEQM"
+6 IF $DATA(RMPFSTAP)
if RMPFSTAP'=""
SET DIC("B")=$PIECE(RMPFSTAP," - ",2)
+7 DO ^DIC
if Y=-1
GOTO END
+8 SET (DA,RMPFSTAN)=+Y
SET RMPFSTAP=$SELECT($DATA(^DIC(4,RMPFSTAN,99)):$PIECE(^(99),U,1),1:"")
if RMPFSTAP'=""
SET RMPFSTAP=RMPFSTAP_" - "
SET RMPFSTAP=RMPFSTAP_$PIECE(Y,U,2)
PARAM IF $DATA(RMPFSTAN)
IF RMPFSTAN
IF $DATA(^RMPF(791813,RMPFSTAN,0))
GOTO SET
A1 WRITE !!,"Do You Wish to Add Parameters for this station? NO// "
+1 DO READ
if $DATA(RMPFOUT)
GOTO END
A11 IF $DATA(RMPFQUT)
WRITE !!,"Enter <Y> to add parameters for this station,",!?6,"<N> or <RETURN> to exit."
GOTO A1
+1 if Y=""
SET Y="N"
SET Y=$EXTRACT(Y,1)
IF "YyNn"'[Y
SET RMPFQUT=""
GOTO A11
+2 if "Nn"[Y
GOTO END
+3 SET DLAYGO=791813
SET DIC(0)="L"
SET DIC="^RMPF(791813,"
SET DINUM=RMPFSTAN
+4 SET X=RMPFSTAN
KILL DD,DO
DO FILE^DICN
SET DA=+Y
+5 IF Y=-1
WRITE !!,"*** UNABLE TO ADD STATION TO PARAMETER FILE ***"
GOTO END
SET SET X=$GET(^RMPF(791813,DA,2))
IF $PIECE(X,U,3)
Begin DoDot:1
+1 SET A=$PIECE(X,U,3)
if 'A
QUIT
if '$DATA(^VA(200,A,0))
QUIT
SET A=$PIECE(^(0),U,1)
+2 SET Y=$PIECE(X,U,4)
DO DD^%DT
+3 WRITE !!?1,"Last User to Run Purge: ",A,!,"Last Date Purge was Run: ",Y,!!
End DoDot:1
+4 SET DIE="^RMPF(791813,"
+5 SET DR=".02;.03;I X'=""S""&(X'=""A"") S Y=.05;.04;.05;.06;.07;.11;.12;.09;.13;.1;1.01;1.02;1.03;1.04;1.05;1.06;2.01;2.02"
+6 DO ^DIE
DO PARAM^RMPFUTL
END KILL %,%DT,%Y,POP,D,C,I,X,D0,DA,DI,DQ,DR,DDH,DZ,DIC,DIE,DISYS,DLAYGO,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
