- RMPFEV1 ;DDC/KAW-REMOTE ORDER/ENTRY PARAMETERS FOR PSAS; [ 06/16/95 3:06 PM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
- RMPFSET S RMPFMENU=10 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
- W @IOF,!,"REMOTE ORDER/ENTRY PARAMETERS FOR PSAS",!!
- 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="10.02;10.03;I X'=""S""&(X'=""A"") S Y=10.05;10.04;10.05;10.06;10.07;10.08;10.09;10.1;11.01;11.02;11.03;11.04;11.06"
- D ^DIE,PARAM^RMPFUTL
- S $P(^RMPF(791813,DA,0),U,7)="A"
- END K %,%DT,%Y,POP,D,C,I,X,D0,DA,DI,DQ,DR,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[HRMPFEV1 1757 printed Mar 13, 2025@21:41:41 Page 2
- RMPFEV1 ;DDC/KAW-REMOTE ORDER/ENTRY PARAMETERS FOR PSAS; [ 06/16/95 3:06 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
- RMPFSET ;;RMPFMENU must be defined
- SET RMPFMENU=10
- 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 WRITE @IOF,!,"REMOTE ORDER/ENTRY PARAMETERS FOR PSAS",!!
- +3 SET DIC=4
- SET DIC(0)="AEQM"
- +4 IF $DATA(RMPFSTAP)
- if RMPFSTAP'=""
- SET DIC("B")=$PIECE(RMPFSTAP," - ",2)
- +5 DO ^DIC
- if Y=-1
- GOTO END
- +6 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="10.02;10.03;I X'=""S""&(X'=""A"") S Y=10.05;10.04;10.05;10.06;10.07;10.08;10.09;10.1;11.01;11.02;11.03;11.04;11.06"
- +6 DO ^DIE
- DO PARAM^RMPFUTL
- +7 SET $PIECE(^RMPF(791813,DA,0),U,7)="A"
- END KILL %,%DT,%Y,POP,D,C,I,X,D0,DA,DI,DQ,DR,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
