source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBPPRV1.m@ 701

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PXBPPRV1 ;ISL/JVS - PROMPT FOR PROVIDER ; 5/31/07 5:10pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,19,27,88,124,186**;Aug 12, 1996;Build 3
3 ;
4 ;
5 ;
6ACTIVE ;---CHECK TO SEE IF ACTIVE PROVIDER
7 ;
8 N PROVIDER,VISIT,DIC,DR,DA,INACTIVE,OK,NOT,PROVEX,BDATA,ACTIVE
9 S PROVIDER=$P(REQI,"^",1) ;-Provider IEN
10 S PROVEX=$P(REQE,"^",1) ;-Provider External form
11 S VISIT=$P(IDATE,".",1) ;-Visit date Internal form
12 ;
13 ; begin patch *186*
14 ;S DIC=200,DR=53.4,DA=PROVIDER,DIQ="INACTIVE",DIQ(0)="IN" D EN^DIQ1
15 ;I $D(INACTIVE),$G(INACTIVE(200,PROVIDER,53.4,"I"))<VISIT S NOT=1
16 ;S DIC=200,DR=9.2,DA=PROVIDER,DIQ="ACTIVE",DIQ(0)="IN" D EN^DIQ1
17 ;I $D(ACTIVE),$G(ACTIVE(200,PROVIDER,9.2,"I"))<VISIT S NOT=1
18 ;---I $G(NOT) W !,IOEDEOP,IORVON,"--WARNING!-",PROVEX," was INACTIVE on the date of this encounter.",IORVOFF D HELP1^PXBUTL1("CON") R OK:DTIME
19 ;I $G(NOT) W !,IOEDEOP,IORVON,"--WARNING!-",PROVEX," was INACTIVE on the date of this encounter.",IORVOFF D PMPT
20 ;
21 S DIC=200,DR=9.2,DA=PROVIDER,DIQ="ACTIVE",DIQ(0)="IN" D EN^DIQ1
22 I $D(ACTIVE),$G(ACTIVE(200,PROVIDER,9.2,"I"))'>VISIT S NOT=1 D
23 . D RSET^PXBDREQ("PRV") S FPRI=1
24 . W !,IOEDEOP,IORVON,"--ERROR!--",PROVEX," was TERMINATED before the date of this encounter.",IORVOFF D HELP1^PXBUTL1("CON") R OK:DTIME
25 ; end patch *186*
26 ;
27 ;---------3/17/97--PART OF FUTURE PATCH 27
28 I '$G(NOT) D
29 .N CLASS
30 .S CLASS=+$$GET^XUA4A72(PROVIDER,$P(VISIT,".")) I CLASS<0 D
31 ..D RSET^PXBDREQ("PRV") S FPRI=1
32 ..W !,IOEDEOP,IORVON,"--ERROR!--",PROVEX," does not have an ACTIVE person class.",IORVOFF D HELP1^PXBUTL1("CON") R OK:DTIME
33 ;---------END 3/17/97
34AXIT ;--EXIT AND KILL
35 K DIQ
36 Q
37PMPT ;--PROMT FOR COMFIRMATION OF USING INACTIVE PORVIDER
38 S DIR("A")="Are you sure you want to select this provider? "
39 S DIR("B")="NO"
40 S DIR(0)="YA"
41 D ^DIR
42 I Y<1 D RSET^PXBDREQ("PRV")
43 Q
44 ;
45ADDM ;--------If Multiple entries have been entered
46 Q
47 ;---NOT POSSIBLE TO ADD MULTIPLE PROVIDERS
48 ;
49DELM ;--------If Multiple deleting
50 ;
51 N DELM,CNT,CPTPRV,PXBJ,BAD,PXBLEN,BDATA
52 S (NF,CNT)=0,PXBLEN=0 S $P(DELM,"^",1)=1
53 I $E(DATA,1)="@" S DATA=$P(DATA,"@",2),NF=1 D
54 .S PXBLEN=$L(DATA,",") F PXI=1:1:PXBLEN S PXBPIECE=$P(DATA,",",PXI) D
55 ..I PXBPIECE'["-"&(PXBPIECE'>0!(PXBPIECE'<(PXBCNT+1))) S BAD(+$G(PXBPIECE))="" Q
56 ..I PXBPIECE'["-" D
57 ...I $D(GONE(PXBPIECE)) Q
58 ...Q:PXBPIECE'?.N
59 ...Q:+PXBPIECE'=PXBPIECE
60 ...S $P(REQI,"^",7)=$O(PXBSKY(PXBPIECE,0)) ;-IEN
61 ...S X=$P(PXBSAM(PXBPIECE),"^",1),DIC="^VA(200,",DIC(0)="ZM" D ^DIC
62 ...S $P(REQI,"^",1)=+Y S CPTPRV=+Y K Y
63 ...S $P(REQI,"^",2)=$P(PXBSAM(PXBPIECE),"^",2) K Y
64 ...S GONE(PXBPIECE)=""
65 ...D EN0^PXBSTOR(PXBVST,PATIENT,REQI,$G(PXMREQ))
66 ...D EN1^PXKMAIN
67 ...I $G(WHAT)["CPT" D DCPT^PXBSTOR1(CPTPRV,PXBVST)
68 ..I PXBPIECE["-" D
69 ...S PXBJ=0 F PXBJ=$P(PXBPIECE,"-",1):1:$P(PXBPIECE,"-",2) D
70 ....I $D(GONE(PXBJ)) Q
71 ....I PXBJ'>0!(PXBJ'<(PXBCNT+1)) S BAD(PXBJ)="" Q
72 ....S $P(REQI,"^",7)=$O(PXBSKY(PXBJ,0)) ;-IEN
73 ....S X=$P(PXBSAM(PXBJ),"^",1),DIC="^VA(200,",DIC(0)="ZM" D ^DIC
74 ....S $P(REQI,"^",1)=+Y S CPTPRV=+Y K Y
75 ....S $P(REQI,"^",2)=$P(PXBSAM(PXBJ),"^",1)
76 ....S GONE(PXBJ)=""
77 ....D EN0^PXBSTOR(PXBVST,PATIENT,REQI,$G(PXMREQ))
78 ....D EN1^PXKMAIN
79 ....I $G(WHAT)["CPT" D DCPT^PXBSTOR1(CPTPRV,PXBVST)
80 K GONE
81 I $G(NF)&($D(BAD)) D Q
82 .S (BDATA,EDATA)="" F S BDATA=$O(BAD(BDATA)) Q:BDATA="" S EDATA=EDATA_BDATA_" "
83 .D WIN17^PXBCC(PXBCNT)
84 .W ! D HELP^PXBUTL0("PRVMD") W !
85 .S DIR(0)="E" D ^DIR K DIR
86 .S:Y=1 DATA="^P" S:Y=0!(Y="") DATA="^" K Y
87 I $G(NF)&('$D(BAD)) S DATA="^P" Q
88 K PRVDR,PXBDPRV
89 Q
90 ;
91PRI ;--Prompt for primary secondary provider
92 ;
93 N DIR,Y,X
94 I $G(FPRI) Q
95 W IOCUD,IOELALL,IOCUU
96 S DIR("A")="Is this the PRIMARY provider for this ENCOUNTER? "
97 S DIR("B")="YES"
98 S DIR("?")="One PRIMARY Provider must be established for each patient encounter. 'Yes' will mean PRIMARY and 'No' will mean SECONDARY."
99 S DIR(0)="Y,A,O"
100 D ^DIR I $G(DIRUT) G PPXIT
101PPFIN ;--Finish off variables
102 I Y=1 S PRI="P^PRIMARY"
103 I Y=0 S PRI="S^SECONDARY"
104 S $P(REQI,"^",2)=$P(PRI,"^",1)
105 S $P(REQE,"^",2)=$P(PRI,"^",2)
106PPXIT ;--EXIT
107 Q
Note: See TracBrowser for help on using the repository browser.