| 1 | PSOTPPRV ;BIR/MHA-TPB NON-VA provider selection ;08/21/03
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**146,153**;DEC 1997
|
|---|
| 3 | ST K DA,DIC,DIE,X,Y,XLFNC
|
|---|
| 4 | W !!,"Select Provider: " R X:$S($D(DTIME):DTIME,1:300) I '$T G KV
|
|---|
| 5 | G:X=""!(X["^")!($D(DTOUT)) KV
|
|---|
| 6 | I X?1."?" D G ST
|
|---|
| 7 | .W !!,"Answer with NEW PERSON NAME, or INITIAL, or SSN, or DEA#, or VA#"
|
|---|
| 8 | S (DIE,DIC)=200,DIC(0)="EMQZ"
|
|---|
| 9 | ;S DIC("S")="I $D(^(""PS"")),$P(^(""PS""),""^""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)'<DT)"
|
|---|
| 10 | D ^DIC G:$D(DUOUT)!($D(DTOUT)) ST N CNT S CNT=0
|
|---|
| 11 | I +Y>0,'$P($G(^VA(200,+Y,"PS")),"^"),$P($G(^VA(200,+Y,"PS")),"^",4),$P(^("PS"),"^",4)'>DT D G ST
|
|---|
| 12 | .W !!,"This Provider is not Authorized to Write Med Orders and flagged as Inactive."
|
|---|
| 13 | .W !,"Use the Edit Provider [PSO PROVIDER EDIT] option to change them."
|
|---|
| 14 | I +Y>0,'$P($G(^VA(200,+Y,"PS")),"^") D G ST
|
|---|
| 15 | .W !!,"This Provider is not Authorized to Write Med Orders. Use the Edit Provider"
|
|---|
| 16 | .W !,"[PSO PROVIDER EDIT] option to change the Authorization flag."
|
|---|
| 17 | I +Y>0 I $P($G(^VA(200,+Y,"PS")),"^",4),$P(^("PS"),"^",4)'>DT D G ST
|
|---|
| 18 | .W !!,"This Provider is flagged as Inactive. Use the Edit Provider"
|
|---|
| 19 | .W !,"[PSO PROVIDER EDIT] option to change the Inactive Date."
|
|---|
| 20 | I +Y>0 D G:CNT STC
|
|---|
| 21 | .I $D(^VA(200,+Y,"PS")),$P(^("PS"),"^"),$S('$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) Q
|
|---|
| 22 | .S CNT=1
|
|---|
| 23 | I +Y>0 D I 'CNT S DA=+Y G GD
|
|---|
| 24 | .I $P($G(^VA(200,+Y,"TPB")),"^"),$P(^("TPB"),"^",5)=0 Q
|
|---|
| 25 | .S CNT=1
|
|---|
| 26 | STC I CNT K CNT S DA=+Y D G:$D(DIRUT)!('Y) ST G:Y EDT
|
|---|
| 27 | .W !,"Please identify Provider as a NON-VA PRESCRIBER in the Provider File.",!
|
|---|
| 28 | .D KV S DIR("A")="Do you want to edit Provider:",DIR("B")="Y",DIR(0)="YN" D ^DIR
|
|---|
| 29 | I Y<0 D G:'$D(X) ST G:$D(DIRUT)!('Y) ST G:Y ADD
|
|---|
| 30 | .I X[""""!($A(X)=45)!($L(X,",")'=2)!(X'?1.E1","1.E) K X Q
|
|---|
| 31 | .S XLFNC=X D STDNAME^XLFNAME(.XLFNC,"C")
|
|---|
| 32 | .S X=XLFNC I $L(X)>35!($L(X)<3) K X Q
|
|---|
| 33 | .W !!,"Provider not found in Provider File"
|
|---|
| 34 | .D KV S DIR("A")="Do you want to enter a new Provider:",DIR("B")="Y",DIR(0)="YN" D ^DIR
|
|---|
| 35 | Q
|
|---|
| 36 | EDT D ASK1^PSOPRVW G GD
|
|---|
| 37 | ADD D ADD^PSOPRVW
|
|---|
| 38 | GD G:'$D(DA) ST
|
|---|
| 39 | I $D(^VA(200,DA,"PS")),$P(^("PS"),"^"),$S('$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) G STQ
|
|---|
| 40 | G ST
|
|---|
| 41 | STQ I $P($G(^VA(200,+DA,"TPB")),"^"),$P(^("TPB"),"^",5)=0 G KV
|
|---|
| 42 | G ST
|
|---|
| 43 | KV K DIR,DIRUT,DTOUT,DUOUT,D,X,Y
|
|---|
| 44 | Q
|
|---|
