source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOTPPRV.m@ 1751

Last change on this file since 1751 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PSOTPPRV ;BIR/MHA-TPB NON-VA provider selection ;08/21/03
2 ;;7.0;OUTPATIENT PHARMACY;**146,153**;DEC 1997
3ST 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
26STC 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
36EDT D ASK1^PSOPRVW G GD
37ADD D ADD^PSOPRVW
38GD 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
41STQ I $P($G(^VA(200,+DA,"TPB")),"^"),$P(^("TPB"),"^",5)=0 G KV
42 G ST
43KV K DIR,DIRUT,DTOUT,DUOUT,D,X,Y
44 Q
Note: See TracBrowser for help on using the repository browser.