1 | PXBMPRV ;ISL/JVS,ESW - MAIN ROUTINE PROVIDER ; 10/31/02 12:10pm
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
|
---|
3 | ;
|
---|
4 | W !,"This is not the entry into this routine" Q
|
---|
5 | ;
|
---|
6 | ; VARABLE LIST
|
---|
7 | ;
|
---|
8 | ;
|
---|
9 | PRV(PXBVST,FROM) ;-----PROVIDER STAND ALONE
|
---|
10 | Q:'$D(^AUPNVSIT(PXBVST))
|
---|
11 | ;
|
---|
12 | ;--Obtain the correct provider
|
---|
13 | ;--Set up
|
---|
14 | N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
|
---|
15 | N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR,PROMPT,CYCL
|
---|
16 | I '$G(PXBPRBLM) N REQI,REQE
|
---|
17 | N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,%,PXBNPRVL
|
---|
18 | N FROM,NOREV
|
---|
19 | S (REQI,REQE)=""
|
---|
20 | S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22)
|
---|
21 | S ^TMP("PXBDPRV",$J,"START")=0,FIRST=1,PROMPT="PRV",PXBEXIT=1
|
---|
22 | D HDR^PXBUTL(PXBVST,1)
|
---|
23 | D REQ^PXBDREQ(5)
|
---|
24 | ;
|
---|
25 | PP ;--------RECYCLE ENTRY POINT
|
---|
26 | D TERM^PXBCC
|
---|
27 | D LOC^PXBCC(3,1) W IOEDEOP
|
---|
28 | N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI ;108
|
---|
29 | D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
|
---|
30 | D EN0^PXBDPRV
|
---|
31 | R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
|
---|
32 | K ERROR S FROM="PRV" D LOC^PXBCC(15,1),PRV^PXBPPRV G:$G(PXBEXIT)<1 PRVXIT G:$G(ERROR) R
|
---|
33 | W IOEDEOP
|
---|
34 | I DATA["^P" D RSET^PXBDREQ("PRV") G PP
|
---|
35 | I $G(PXBUT)=1,'$D(FIRST) G PRVXIT
|
---|
36 | I $G(PXBUT)=1,$D(LEAVE) G PRVXIT
|
---|
37 | K FIRST
|
---|
38 | I $G(PXBUT)=1 G PRVXIT
|
---|
39 | ;
|
---|
40 | ;--Prompt for Primary or Secondary Provider
|
---|
41 | D PRI^PXBPPRV1
|
---|
42 | I $D(DIRUT) D RSET^PXBDREQ("PRV") G PP
|
---|
43 | ;
|
---|
44 | ;--Store the DATA
|
---|
45 | D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
|
---|
46 | ;
|
---|
47 | ;--Display the Requested Provider
|
---|
48 | D PRINT^PXBDREQ(1)
|
---|
49 | ;
|
---|
50 | ;--File the data into the V files
|
---|
51 | D EN1^PXKMAIN
|
---|
52 | ;
|
---|
53 | ;--IF called from DIAGNOSIS prompts
|
---|
54 | I '$G(PXBPRBLM) D RSET^PXBDREQ("PRV")
|
---|
55 | I $G(PXBPRBLM) G PRVXIT
|
---|
56 | G PP
|
---|
57 | ;
|
---|
58 | PRVXIT ;----EXIT AND CLEAN UP
|
---|
59 | D PRIM^PXBUTL
|
---|
60 | D FULL0^PXBCC
|
---|
61 | D CLEAR1^PXBCC
|
---|
62 | K PXBKY,PXBSAM,PXBSKY,PXBVST
|
---|
63 | ;
|
---|
64 | ;----Do the EVENT to the Protocol
|
---|
65 | ;D EVENT^PXKMAIN
|
---|
66 | K ^TMP("PXBSTOR",$J),^TMP("PXK",$J),^TMP("PXBDPRV",$J)
|
---|
67 | K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
|
---|
68 | Q
|
---|