source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBMPRV.m@ 677

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1PXBMPRV ;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 ;
9PRV(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 ;
25PP ;--------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
31R 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 ;
58PRVXIT ;----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
Note: See TracBrowser for help on using the repository browser.