- RMPFET ;DDC/KAW-ENTER/EDIT PATIENT ORDERS; [ 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,"ENTER/EDIT PATIENT ORDERS",!
- PAT W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y D PAT^RMPFUTL
- D DISP^RMPFDD,CONT G END:$D(RMPFOUT)
- SELECT I '$D(RMPFTE),$D(DFN) D ^RMPFDD2
- S (RMPFORD,RMPFTP)="P" D ^RMPFDS1 G END:$D(RMPFOUT)
- K RMPFX G ADD:'RMPFCX
- D SEL G END:$D(RMPFOUT),PAT:RMPFSEL1=""
- G ADD:"Aa"[RMPFSEL1,RMPFSET:'$D(RMPFX)
- ADDEDIT S S0=^RMPF(791810,RMPFX,0),RMPFST=$P(S0,U,3),RMPFTYP=$P(S0,U,2)
- S RMPFHAT="" I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFHAT=$P(^(0),U,2)
- S X="" I RMPFST,$D(^RMPF(791810.2,RMPFST,0)) S X=$P(^(0),U,2)
- S:"IPED"[X RMPFEDIT="" N RMPFHAT,RMPFTYP,RMPFST,RMPFTP,RMPFTE
- D ^RMPFDT1 G END:$D(RMPFOUT) K RMPFEDIT
- D ^RMPFET0 G END:$D(RMPFOUT) I $D(RMPFSEL),RMPFSEL="E" G ADD
- I $D(RMPFSEL),"Dd"[RMPFSEL K RMPFTE G SELECT
- G ADDEDIT:$D(RMPFSEL)!$D(RMPFQUT) I '$D(RMPFX) K RMPFTE G SELECT
- ADD D ^RMPFET1 G END:$D(RMPFOUT),RMPFSET:'$D(RMPFX),ADDEDIT
- END K DFN,RMPFNAM,RMPFDOB,RMPFSSN,RMPFE,RMPFCX,RMPFSEL,RMPFO,RMPFS
- K RMPFTP,RMPFEDIT,RMPFTYP,RMPFHAT,RMPFST,RMPFY1,L,%Y,RMPFORD,D1,RMPFO
- K RMPFOUT,RMPFQUT,RMPFSEL1,RMPFTE,ZZ,ST,RMPFMOD
- K %,%DT,POP,AB,DA,DR,CX,CN,C,I,X,Y,CM,M,ZY,DIE,DI,DQ,DIC,D0,%,DISYS Q
- CONT F I=1:1 Q:$Y>21 W !
- W !,"Enter <RETURN> to continue or <^> to exit: " D READ
- G CONT:$D(RMPFQUT) K RMPFS,CX,X,I 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
- SEL ;;Select action to be taken on order
- ;; input: RMPFS (opt.)
- ;;output: RMPFX,RMPFSEL1
- K RMPFX I '$D(RMPFS) S RMPFSEL1="A" G SELE
- F I=1:1 Q:$Y>21 W !
- SEL1 W !,"Select a Number to edit, <A>dd or <RETURN> to exit: " D READ
- G SELE:$D(RMPFOUT)
- SEL2 I $D(RMPFQUT) W !!,"Enter the number to the left of the order you wish to edit",!?5,"<A> to add a new order or",!?5,"<RETURN> to continue." G SEL1
- S RMPFSEL1=Y G SELE:RMPFSEL1="",SELE:"Aa"[RMPFSEL1
- I '$D(RMPFS(Y)) S RMPFQUT="" G SEL2
- S RMPFX=RMPFS(Y)
- SELE K RMPFS,X,Y,I Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFET 2330 printed Feb 19, 2025@00:02:44 Page 2
- RMPFET ;DDC/KAW-ENTER/EDIT PATIENT ORDERS; [ 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,"ENTER/EDIT PATIENT ORDERS",!
- PAT WRITE !
- SET DIC=2
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y=-1
- GOTO END
- SET DFN=+Y
- DO PAT^RMPFUTL
- +1 DO DISP^RMPFDD
- DO CONT
- if $DATA(RMPFOUT)
- GOTO END
- SELECT IF '$DATA(RMPFTE)
- IF $DATA(DFN)
- DO ^RMPFDD2
- +1 SET (RMPFORD,RMPFTP)="P"
- DO ^RMPFDS1
- if $DATA(RMPFOUT)
- GOTO END
- +2 KILL RMPFX
- if 'RMPFCX
- GOTO ADD
- +3 DO SEL
- if $DATA(RMPFOUT)
- GOTO END
- if RMPFSEL1=""
- GOTO PAT
- +4 if "Aa"[RMPFSEL1
- GOTO ADD
- if '$DATA(RMPFX)
- GOTO RMPFSET
- ADDEDIT SET S0=^RMPF(791810,RMPFX,0)
- SET RMPFST=$PIECE(S0,U,3)
- SET RMPFTYP=$PIECE(S0,U,2)
- +1 SET RMPFHAT=""
- IF RMPFTYP
- IF $DATA(^RMPF(791810.1,RMPFTYP,0))
- SET RMPFHAT=$PIECE(^(0),U,2)
- +2 SET X=""
- IF RMPFST
- IF $DATA(^RMPF(791810.2,RMPFST,0))
- SET X=$PIECE(^(0),U,2)
- +3 if "IPED"[X
- SET RMPFEDIT=""
- NEW RMPFHAT,RMPFTYP,RMPFST,RMPFTP,RMPFTE
- +4 DO ^RMPFDT1
- if $DATA(RMPFOUT)
- GOTO END
- KILL RMPFEDIT
- +5 DO ^RMPFET0
- if $DATA(RMPFOUT)
- GOTO END
- IF $DATA(RMPFSEL)
- IF RMPFSEL="E"
- GOTO ADD
- +6 IF $DATA(RMPFSEL)
- IF "Dd"[RMPFSEL
- KILL RMPFTE
- GOTO SELECT
- +7 if $DATA(RMPFSEL)!$DATA(RMPFQUT)
- GOTO ADDEDIT
- IF '$DATA(RMPFX)
- KILL RMPFTE
- GOTO SELECT
- ADD DO ^RMPFET1
- if $DATA(RMPFOUT)
- GOTO END
- if '$DATA(RMPFX)
- GOTO RMPFSET
- GOTO ADDEDIT
- END KILL DFN,RMPFNAM,RMPFDOB,RMPFSSN,RMPFE,RMPFCX,RMPFSEL,RMPFO,RMPFS
- +1 KILL RMPFTP,RMPFEDIT,RMPFTYP,RMPFHAT,RMPFST,RMPFY1,L,%Y,RMPFORD,D1,RMPFO
- +2 KILL RMPFOUT,RMPFQUT,RMPFSEL1,RMPFTE,ZZ,ST,RMPFMOD
- +3 KILL %,%DT,POP,AB,DA,DR,CX,CN,C,I,X,Y,CM,M,ZY,DIE,DI,DQ,DIC,D0,%,DISYS
- QUIT
- CONT FOR I=1:1
- if $Y>21
- QUIT
- WRITE !
- +1 WRITE !,"Enter <RETURN> to continue or <^> to exit: "
- DO READ
- +2 if $DATA(RMPFQUT)
- GOTO CONT
- KILL RMPFS,CX,X,I
- 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
- SEL ;;Select action to be taken on order
- +1 ;; input: RMPFS (opt.)
- +2 ;;output: RMPFX,RMPFSEL1
- +3 KILL RMPFX
- IF '$DATA(RMPFS)
- SET RMPFSEL1="A"
- GOTO SELE
- +4 FOR I=1:1
- if $Y>21
- QUIT
- WRITE !
- SEL1 WRITE !,"Select a Number to edit, <A>dd or <RETURN> to exit: "
- DO READ
- +1 if $DATA(RMPFOUT)
- GOTO SELE
- SEL2 IF $DATA(RMPFQUT)
- WRITE !!,"Enter the number to the left of the order you wish to edit",!?5,"<A> to add a new order or",!?5,"<RETURN> to continue."
- GOTO SEL1
- +1 SET RMPFSEL1=Y
- if RMPFSEL1=""
- GOTO SELE
- if "Aa"[RMPFSEL1
- GOTO SELE
- +2 IF '$DATA(RMPFS(Y))
- SET RMPFQUT=""
- GOTO SEL2
- +3 SET RMPFX=RMPFS(Y)
- SELE KILL RMPFS,X,Y,I
- QUIT
