| 1 | PXBPORD ;ISL/JVS - PROMPT ORDERING PROVIDER ; 6/27/07 6:45pm
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,186**;Aug 12, 1996;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ORD ;--Ordering Provider
|
|---|
| 5 | N TIMED,DATA,DIC,X,Y,CPTORD
|
|---|
| 6 | S CPTORD=$S($P(REQI,U,22):$P(^VA(200,$P(REQI,U,22),0),U,1),1:"")
|
|---|
| 7 | S TIMED="I '$T!(DATA[""^"")"
|
|---|
| 8 | D WIN17^PXBCC(PXBCNT),LOC^PXBCC(16,0)
|
|---|
| 9 | W IOSC,IOEDEOP
|
|---|
| 10 | O ;--SECOND ENTRY POINT
|
|---|
| 11 | ; begin patch *186*
|
|---|
| 12 | ;W IORC," Enter Ordering Provider: "_$G(CPTORD)_"//",IOELEOL
|
|---|
| 13 | W IORC," Enter Ordering Provider: "_$G(CPTORD)_" // "
|
|---|
| 14 | W IOSC,IOELEOL
|
|---|
| 15 | ; end patch *186*
|
|---|
| 16 | R DATA:DTIME
|
|---|
| 17 | O1 ;---
|
|---|
| 18 | X TIMED I G ORDX
|
|---|
| 19 | I DATA="@" S $P(REQI,"^",22)="@" G ORDX
|
|---|
| 20 | I DATA="^"!(DATA="^^")!(DATA["^O") G ORDX
|
|---|
| 21 | ;I DATA="?" D EN1^PXBHLP0("PXB","ORD",1,"",1) G O
|
|---|
| 22 | ;I DATA="??" S DOUBLEQQ=1 D EN1^PXBHLP0("PXB","ORD","",1,2) S:DATA="O" UDATA="^O" S:$L(DATA,"^")>1 (Y,DATA,EDATA)=$P(DATA,"^",2) S:$G(UDATA)="" UDATA="^O" S:UDATA="^O" (DATA,EDATA,Y)=UDATA G:UDATA="^O" O1
|
|---|
| 23 | I DATA="?" D HELP^PXBUTL0("OP1") G O
|
|---|
| 24 | I DATA="??" D HELP^PXBUTL0("OP2") G O
|
|---|
| 25 | I DATA="",$G(CPTORD)'="" S DATA=CPTORD
|
|---|
| 26 | I DATA="" G ORDX
|
|---|
| 27 | D CASE^PXBUTL
|
|---|
| 28 | ;----SPACE BAR---
|
|---|
| 29 | I DATA'=" ",DATA'["^",DATA'="" S ^DISV(DUZ,"PXBORD-22")=DATA
|
|---|
| 30 | I DATA=" ",$D(^DISV(DUZ,"PXBORD-22")) S DATA=^DISV(DUZ,"PXBORD-22") W DATA
|
|---|
| 31 | ;--If a "?" is NOT entered during lookup
|
|---|
| 32 | ; begin patch *186*
|
|---|
| 33 | ; S X=DATA,DIC=200,DIC(0)="OQME" D ^DIC
|
|---|
| 34 | ; I Y=-1 S $P(REQE,U,22)="" G ORDX
|
|---|
| 35 | S DIC("S")="I $$ACTIVPRV^PXAPI(Y,$G(IDATE,DT))"
|
|---|
| 36 | S X=DATA,DIC=200,DIC(0)="OQME" D ^DIC
|
|---|
| 37 | I +Y>0 D
|
|---|
| 38 | . W IORC W:$G(CPTORD)'=X X W IOEDEOP
|
|---|
| 39 | E D G O
|
|---|
| 40 | . N EDATA S EDATA=X
|
|---|
| 41 | . D LOC^PXBCC(16,0),HELP^PXBUTL0("PRVM")
|
|---|
| 42 | . D HELP1^PXBUTL1("CON") R X:DTIME
|
|---|
| 43 | . D LOC^PXBCC(16,0) W IOSC,IOEDEOP
|
|---|
| 44 | ; end patch *186*
|
|---|
| 45 | ;
|
|---|
| 46 | S $P(REQI,U,22)=+Y,$P(REQE,U,22)=$P(Y,U,2)
|
|---|
| 47 | ORDX ;--EXIT AND CLEANUP
|
|---|
| 48 | I '$D(REQE) S REQE=""
|
|---|
| 49 | I $P(REQE,U,22)="" S $P(REQI,U,22)=""
|
|---|
| 50 | Q
|
|---|
