- RMPFDX ;DDC/KAW-STATION ORDER INFORMATION [ 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,!,"STATION ORDER INFORMATION" H 1
- LIST S RMPFP="*",(RMPFORD,RMPFTP)="S" D ^RMPFDS1 K RMPFX D SEL:RMPFCX
- G END:$D(RMPFOUT)!'$D(RMPFX)
- START D DISP,CONT G END:$D(RMPFOUT),START:$D(RMPFX),LIST
- END K RMPFO,RMPFP,RMPFORD,RMPFTP,RMPFX,RMPFCX,RMPFOUT,RMPFQUT,RMPFS
- K T,J,L,Y,DFN,RMPFERR Q
- CONT F I=1:1 Q:$Y>(IOSL-4) W !
- W !!,"Type <P>rint,"
- I $O(^RMPF(791810,RMPFX,201,0)) W " <M>essages,"
- W " <RETURN> to continue or <^> to exit: " D READ K I
- I $D(RMPFOUT) K Y Q
- I $D(RMPFQUT) D MSG^RMPFDT Q
- I Y="" K RMPFX Q
- S Y=$E(Y,1) I "Pp"[Y D QUE K RMPFX Q
- I "mM"[Y D ^RMPFDT4 K RMPFX Q
- QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP I IO=IO(0),'$D(IO("S")) D DISP,CONT G QUEE
- I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G DISP^RMPFDX
- S ZTRTN="DISP^RMPFDX",ZTSAVE("RMPF*")="",ZTIO=ION
- S ZTDESC="STATION ORDER INFO" D ^%ZTLOAD D HOME^%ZIS
- W:$D(ZTSK) !!,"*** Request Queued ***" H 2
- QUEE K %,%T,%ZIS,POP,Y1,ZTSK,ZTDESC,ZTRTN,ZTIO,ZTSAVE 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
- DISP D ^RMPFDT1
- Q
- SEL W !!,"Select Order Number or <RETURN> to exit: " D READ
- Q:$D(RMPFOUT)
- SEL1 I $D(RMPFQUT) W !!,"Type the number of the order you wish to view or <RETURN> to continue." G SEL
- Q:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G SEL1
- S RMPFX=RMPFS(Y) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDX 1712 printed Mar 13, 2025@21:41:06 Page 2
- RMPFDX ;DDC/KAW-STATION ORDER INFORMATION [ 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,!,"STATION ORDER INFORMATION"
- HANG 1
- LIST SET RMPFP="*"
- SET (RMPFORD,RMPFTP)="S"
- DO ^RMPFDS1
- KILL RMPFX
- if RMPFCX
- DO SEL
- +1 if $DATA(RMPFOUT)!'$DATA(RMPFX)
- GOTO END
- START DO DISP
- DO CONT
- if $DATA(RMPFOUT)
- GOTO END
- if $DATA(RMPFX)
- GOTO START
- GOTO LIST
- END KILL RMPFO,RMPFP,RMPFORD,RMPFTP,RMPFX,RMPFCX,RMPFOUT,RMPFQUT,RMPFS
- +1 KILL T,J,L,Y,DFN,RMPFERR
- QUIT
- CONT FOR I=1:1
- if $Y>(IOSL-4)
- QUIT
- WRITE !
- +1 WRITE !!,"Type <P>rint,"
- +2 IF $ORDER(^RMPF(791810,RMPFX,201,0))
- WRITE " <M>essages,"
- +3 WRITE " <RETURN> to continue or <^> to exit: "
- DO READ
- KILL I
- +4 IF $DATA(RMPFOUT)
- KILL Y
- QUIT
- +5 IF $DATA(RMPFQUT)
- DO MSG^RMPFDT
- QUIT
- +6 IF Y=""
- KILL RMPFX
- QUIT
- +7 SET Y=$EXTRACT(Y,1)
- IF "Pp"[Y
- DO QUE
- KILL RMPFX
- QUIT
- +8 IF "mM"[Y
- DO ^RMPFDT4
- KILL RMPFX
- QUIT
- QUE WRITE !
- SET %ZIS="NPQ"
- DO ^%ZIS
- if POP
- GOTO END
- IF IO=IO(0)
- IF '$DATA(IO("S"))
- DO DISP
- DO CONT
- GOTO QUEE
- +1 IF $DATA(IO("S"))
- SET %ZIS=""
- SET IOP=ION
- DO ^%ZIS
- GOTO DISP^RMPFDX
- +2 SET ZTRTN="DISP^RMPFDX"
- SET ZTSAVE("RMPF*")=""
- SET ZTIO=ION
- +3 SET ZTDESC="STATION ORDER INFO"
- DO ^%ZTLOAD
- DO HOME^%ZIS
- +4 if $DATA(ZTSK)
- WRITE !!,"*** Request Queued ***"
- HANG 2
- QUEE KILL %,%T,%ZIS,POP,Y1,ZTSK,ZTDESC,ZTRTN,ZTIO,ZTSAVE
- 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
- DISP DO ^RMPFDT1
- +1 QUIT
- SEL WRITE !!,"Select Order Number or <RETURN> to exit: "
- DO READ
- +1 if $DATA(RMPFOUT)
- QUIT
- SEL1 IF $DATA(RMPFQUT)
- WRITE !!,"Type the number of the order you wish to view or <RETURN> to continue."
- GOTO SEL
- +1 if Y=""
- QUIT
- IF '$DATA(RMPFS(Y))
- SET RMPFQUT=""
- GOTO SEL1
- +2 SET RMPFX=RMPFS(Y)
- QUIT
