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 Apr 09, 2024@21:38:32 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
