| 1 | RMPFDB1 ;DDC/KAW-DISPLAY TRANSMISSION BATCH; [ 09/03/97 3:42 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995
|
|---|
| 3 | ;; input: RMPFBT
|
|---|
| 4 | ;;output: RMPFB
|
|---|
| 5 | G END:'$D(RMPFBT),END:'$D(^RMPF(791812,RMPFBT,0)) S S0=^(0)
|
|---|
| 6 | S Y=$P(S0,U,1) D DD^%DT S RMPFBDT=Y,RMPFSTP="",RMPFST=$P(S0,U,2)
|
|---|
| 7 | S RMPFSTP=$S(RMPFST=1:"OPEN",RMPFST=2:"CLOSED",RMPFST=3:"TRANSMITTED",RMPFST=4:"RECEIVED BY DDC",1:"")
|
|---|
| 8 | S RMPFBNA=$P(S0,U,4) D HEAD S (CT,RMPFBJ)=0
|
|---|
| 9 | A1 S RMPFBJ=$O(^RMPF(791812,RMPFBT,101,RMPFBJ)) G B1:'RMPFBJ,A1:'$D(^(RMPFBJ,0)) S S0=^(0),RMPFDU=$P(S0,U,2),RMPFDUP=""
|
|---|
| 10 | I RMPFDU,$D(^VA(200,RMPFDU,0)) S RMPFDUP=$P(^(0),U,1)
|
|---|
| 11 | S RMPFDTD="",Y=$P(S0,U,3) I Y D DD^%DT S RMPFDTD=Y
|
|---|
| 12 | S RMPFDLR=$P(S0,U,4),RMPFX=$P(S0,U,1) G A1:'RMPFX
|
|---|
| 13 | S RMPFDL=$S(RMPFDUP'="":"YES",1:"")
|
|---|
| 14 | G A1:'$D(^RMPF(791810,RMPFX,0)) S S0=^(0),Y=$P(S0,U,1)
|
|---|
| 15 | D DD^%DT S RMPFTD=Y,RMPFTYP="",X=$P(S0,U,2)
|
|---|
| 16 | I X,$D(^RMPF(791810.1,X,0)) S RMPFTYP=$P(^(0),U,8)
|
|---|
| 17 | S RMPFAD=$P(S0,U,8),RMPFADP="" I RMPFAD,$D(^VA(200,RMPFAD,0)) S RMPFADP=$P(^(0),U,1)
|
|---|
| 18 | S DFN=$P(S0,U,4),RMPFNAM="N/A"
|
|---|
| 19 | I DFN D PAT^RMPFUTL
|
|---|
| 20 | I $Y>$S(IOST?1"C-".E:20,1:58) D CONT G END:$D(RMPFOUT),END:$D(ZTSK),END:'$D(RMPFBDT) D HEAD
|
|---|
| 21 | S CT=CT+1 W !,$J(CT,2),". ",$E(RMPFTD,1,18),?24,$E(RMPFTYP,1,6),?32,$E(RMPFADP,1,17),?51,$E(RMPFNAM,1,19),?74,RMPFDL S RMPFB(CT)=RMPFBJ
|
|---|
| 22 | I RMPFDL="YES" W !?4,"Deleted By: ",$E(RMPFDUP,1,18) W:RMPFDLR'="" ?42,"Reason: ",$E(RMPFDLR,1,30)
|
|---|
| 23 | G A1
|
|---|
| 24 | B1 W !!,"Total Orders in Batch: ",CT
|
|---|
| 25 | W:IOST?1"P-".E @IOF
|
|---|
| 26 | D:$D(IO("S")) ^%ZISC
|
|---|
| 27 | END K RMPFBDT,RMPFSTP,RMPFST,RMPFBNA,RMPFBJ,RMPFDU,RMPFDUP,RMPFDLR
|
|---|
| 28 | K RMPFX,RMPFDL,RMPFDLR,RMPFTD,RMPFTYP,RMPFAD,RMPFADP,DFN,RMPFNAM
|
|---|
| 29 | K RMPFDOB,RMPFSSN,RMPFDTD,RMPFDOD,S0,CT,I,X,Y Q
|
|---|
| 30 | HEAD W @IOF,!?17,"REMOTE ORDER/ENTRY TRANSMISSION BATCH ENTRIES"
|
|---|
| 31 | W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|---|
| 32 | W !?2,"Batch: ",RMPFBDT,?37,"Status: ",$E(RMPFSTP,1,14),?62,"Number Active: ",$J(RMPFBNA,3)
|
|---|
| 33 | W ! F I=1:1:80 W "-"
|
|---|
| 34 | W !," #",?5,"Order Date/Time",?25,"Type",?35,"Ordered By",?57,"Patient",?72,"Deleted"
|
|---|
| 35 | W !,"---",?4,"------------------",?24,"------",?32,"-----------------",?51,"-------------------",?72,"--------" W !
|
|---|
| 36 | Q
|
|---|
| 37 | CONT F I=1:1 Q:$Y>20 W !
|
|---|
| 38 | W !,"Enter <RETURN> to continue, <P>rint or <^> to exit: " D READ
|
|---|
| 39 | Q:$D(RMPFOUT) I $D(RMPFQUT) D MSG^RMPFDD G CONT
|
|---|
| 40 | Q:Y="" S Y=$E(Y,1) G CONT:"Pp"'[Y D QUE
|
|---|
| 41 | Q
|
|---|
| 42 | QUE S ZTRTN="^RMPFDB1",ZTDESC="ORDER BATCH"
|
|---|
| 43 | S %ZIS="NPQ" D ^%ZIS G QUEE:POP
|
|---|
| 44 | I IO=IO(0),'$D(IO("S")) G RMPFDB1
|
|---|
| 45 | I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDB1
|
|---|
| 46 | S ZTSAVE("RM*")="",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS
|
|---|
| 47 | W:$D(ZTSK) !!,"*** Request Queued ***" H 2
|
|---|
| 48 | QUEE Q
|
|---|
| 49 | READ K RMPFOUT,RMPFQUT
|
|---|
| 50 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 51 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 52 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 53 | Q
|
|---|
